File Coverage

blib/lib/Text/MicroMason/HTMLTemplate.pm

Criterion	Covered	Total	%
statement	31	42	73.8
branch	16	22	72.7
condition	0	5	0.0
subroutine	11	14	78.5
pod	4	12	33.3
total	62	95	65.2

package Text::MicroMason::HTMLTemplate;

require Text::MicroMason::Base;
require Text::MicroMason::TemplateDir;
require Text::MicroMason::StoreOne;
require Text::MicroMason::HasParams;
push @ISA, map "Text::MicroMason::$_", qw( TemplateDir StoreOne HasParams );

use strict;

######################################################################

my %param_mapping = (    		### <<== INCOMPLETE ###
  global_vars => 'loop_global_vars',
  cache => '-CompileCache',
  path => '-TemplatePaths',
);

######################################################################

sub output { (shift)->execute_again( @_ ) }

######################################################################

my $prefix_re = '[tT][mM][pP][lL]_';

sub lex_token {
  # warn " Lexer: " . pos($_) . " of " . length($_) . "\n";
  # Tags in format "", "", or ""
  /\G \<(\/?)($prefix_re\w+)\s*(.*?)\> /gcxs
	? ( ( $1 ? "tmpl_end" : lc($2) ) => { $_[0]->parse_args($3) } ) :

  # Things that don't match the above
  /\G ( (?: [^<] | <(?!\/?$prefix_re) )+ ) /gcxs ? ( 'text' => $1 ) :

  # Lexer error
  ()
}

sub parse_args {
  my $self = shift;
  my $args = "$_[0]";
  return () unless length($args);
  return ( name => $args ) unless ( $args =~ /=/ );
  my @tokens;
  until ( $args =~ /\G\z/gc ) {
    push ( @tokens,
      $args =~ /\G \s* (\w+) \= (?: \"([^\"]+)\" | ( \w+ ) ) (?= \s | \z ) /gcxs
	? ( lc($1) => ( defined($2) ? $2 : $3 ) ) :
      $args =~ /\G ( .{0,20} ) /gcxs
	&& die "Couldn't find applicable parsing rule at '$1'\n"
    );
  }
  @tokens;
}

######################################################################

sub assemble_tmpl_var {
  my ($self, $args) = @_;

  my $output = "\$m->param( '$args->{name}' )";
  if ( defined $args->{default} ) {
    $output = "local \$_ = $output; defined ? \$_ : '$args->{default}'"
  }
  if ( $args->{escape} ) {
    $output = "\$m->filter( $output, '$args->{escape}' )"
  }
  expr => "$output;"
}

sub assemble_tmpl_include {
  my ($self, $args) = @_;
  file => $args->{name}
}

sub assemble_tmpl_loop {
  my ($self, $args) = @_;
  if ( ! $self->{loop_context_vars} ) {
    perl => q/foreach my $args ( $m->param( '/ . $args->{name} . q/' ) ) {
      local $m->{params} = [ $args, $m->{loop_global_vars} ? @{$m->{params}} : () ];/
  } else {
    perl => q/my @loop = $m->param( '/ . $args->{name} . q/' );
      foreach my $count ( 0 .. $#loop ) {
    my $args = $loop[ $count ];
    my %loop_context = (
      __counter__ => $count,
      __odd__ => ( $count % 2 ),
      __first__ => ( $count == 0 ),
      __inner__ => ( $count > 0 and $count < $#loop ),
      __last__ => ( $count == $#loop ),
    );
    local $m->{params} = [ $args, \%loop_context, $m->{loop_global_vars} ? @{$m->{params}} : () ];
      /
  }
}

sub assemble_tmpl_if {
  my ($self, $args) = @_;
  perl => q/if ( $m->param( '/ . $args->{name} . q/' ) ) { /
}

sub assemble_tmpl_unless {
  my ($self, $args) = @_;
  perl => q/if ( ! $m->param( '/ . $args->{name} . q/' ) ) { /
}

sub assemble_tmpl_else {
  perl => "} else {"
}

sub assemble_tmpl_end {
  perl => "}"
}

######################################################################

use vars qw( %Filters );

sub defaults {
  (shift)->NEXT('defaults'), filters => \%Filters,
}

# Output filtering
$Filters{1} = $Filters{html} = \&HTML::Entities::encode
					if eval { require HTML::Entities};
$Filters{url} = \&URI::Escape::uri_escape if eval { require URI::Escape };

# $result = $mason->filter( @filters, $content );
sub filter {
  my $self = shift;
  my $content = pop;

  foreach my $filter ( @_ ) {
    my $function = ( ref $filter eq 'CODE' ) ? $filter :
	$self->{filters}{ $filter } ||
	  $self->croak_msg("No definition for a filter named '$filter'" );
    $content = &$function($content)
  }
  $content
}

######################################################################

1;

__END__