File Coverage

blib/lib/Template/Magic/Zone.pm

Criterion	Covered	Total	%
statement	93	97	95.8
branch	43	48	89.5
condition	8	10	80.0
subroutine	18	20	90.0
pod	7	7	100.0
total	169	182	92.8

package Template::Magic::Zone ;
$VERSION = 1.40 ;
use strict ;
use 5.006_001 ;

# This file uses the "Perlish" coding style
# please read http://perl.4pro.net/perlish_coding_style.html

; our $AUTOLOAD
; $Carp::Internal{+__PACKAGE__}++

; BEGIN
   { *OK = sub () { 1 }
   }

; BEGIN
   { foreach my $n (qw| zone output text post |)
      { no strict 'refs'
      ; *{$n.'_process'} = sub
                            { my ($z) = @_
                            ; my $ch = $z->tm->{$n.'_handlers'} || return
                            ; HANDLER:
                              foreach my $h ( @$ch )
                               { return OK if $h->(@_)
                               }
                            }
      }
   ; *mt = sub{shift()->tm(@_)}  # backward compatibility
   }

; use Class::constr
; use Object::props
  ( { name       => [ qw| id
                          attributes
                          is_main
                          _t
                          container
                          output
                        |
                    ]
    , protected  => 1
    }
  , { name       => 'level'
    , protected  => 1
    , default    => -1
    }
  , qw| param
        location
        value
        _s
        _e
      |
  )

; sub value_process
   { my ($z) = @_
   ; my $tm = $z->tm
   ; my $v = $z->value
   ; if ( defined $v && length $v )
      { delete $$tm{_NOT_lookup}{'NOT_'.$z->id}
      }
     else
      { $$tm{_NOT_lookup}{'NOT_'.$z->id} = {}
      ; return unless defined($v)
      }
   ; my $ch = $$tm{value_handlers} || return
   ; HANDLER:
     foreach my $h ( @$ch )
      { return OK if &$h(@_)
      }
   }

; sub AUTOLOAD : lvalue
   { (my $n = $AUTOLOAD) =~ s/.*://
   ; return if $n eq 'DESTROY'
   ; @_ == 2
     ? ( $_[0]{__CUSTOM}{$n} = $_[1] )
     :   $_[0]{__CUSTOM}{$n}
   }

; sub tm
   { my ($az) = my ($z) = @_ ;
   ; until (defined $$az{tm}){ $az = $az->container }
   ; $$az{tm}
   }

; sub content_process
   { my ($z) = @_
   ; defined $z->_e || return  # content or return
   ; ZONE:
     for ( my $i  = $z->_s
         ;    $i <= $z->_e
         ;    $i++
         )
      { my $item = $z->_t->[$i][1]
      ; if ( not $item )                       # just text
         { $z->text_process( $z->_t->[$i][0] )
         }
        elsif ( ref $item eq 'HASH' )          # normal zone
         { my $nz = ref($z)->new( %$item
                                , level     => $z->level + 1
                                , container => $z
                                , _t        => $z->_t
                                )
         ; $i = $nz->_e + 1 if $nz->_e         # skip block content
         ; next ZONE if $nz->zone_process
         ; $nz->lookup_process
         ; $nz->value_process
         ; $nz->post_process
         }
        elsif ( $item eq 'CONTAINER_INCLUDE' )
         { $z->include_template($z->tm->{_included_template})
         }
        elsif ( $item->is_main )               # included file
         { $z->_include($item)
         }
      }
   }

; sub _include
   { my ($z, $iz) = @_
   ; @$iz{qw|container level tm|} = ( $z
                                    , $z->level
                                    , $z->tm
                                    )
   ; $iz->content_process
   ; delete @$iz{qw|container level tm|}   # reset
   }

; sub lookup_process
   { my ($z) = @_
   ; defined $z->value and return
   ; $z->value($z->lookup)
   }

; sub lookup
   { my ( $z, $id ) = @_
   ; $id ||= $z->id
   ; my $val
   ; for ( my $az = $z->container
         ;    $az->container
         ;    $az = $az->container
         )
      { $val = $z->_lookup( $az->value, $id )
      ; return $val if defined $val
      }
   ; my $tm = $z->tm
   ; foreach my $l ( @{$$tm{_temp_lookups}}
                   , @{$$tm{lookups}}
                   , $$tm{_NOT_lookup}
                   )
      { next unless $l
      ; $val = $z->_lookup( $l, $id )
      ; return $val if defined $val
      }
   ; undef
   }

; sub _lookup
   { my ($z, $l, $id) = @_
   ; return unless $l
   ; $z->location = $l
   ; if ( ref $l eq 'HASH' )
      { $$l{$id}
      }
     elsif ( my $code = UNIVERSAL::can( $l, $id ) )
      { $code
      }
     else
      { no strict 'refs','vars'
      ; local *S = $l.'::'.$id
      ; defined $S ?  $S
            : @S ? \@S
            : %S ? \%S
            : undef
      }
   }

; sub content
   { my ($z) = @_
   ; defined $z->_e || return
   ; join '' , map { $$_[0]
                   }
                   @{$z->_t} [ $z->_s
                               ..
                               $z->_e
                             ]
   }

; sub include_template
   { my ($z, $t) = @_
   ; my $nz = $z->tm->load($t)
   ; $z->_include($nz)
   ; return undef
   }

; 1

__END__