view release on metacpan or  search on metacpan

lib/Template/Magic.pm  view on Meta::CPAN

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

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

; use Carp
; $Carp::Internal{+__PACKAGE__}++
; use warnings::register
; use Template::Magic::Zone
; use IO::Util
; use Class::Util
; use File::Spec

; sub NEXT_HANDLER () { 0 }
; sub LAST_HANDLER () { 1 }

; sub import
   { my ($pkg, $pragma) = @_
   ; if (  $pragma
        && $pragma eq '-compile'
        )
      { carp "The -compile pragma has no effect since version 1.39"
        if warnings::enabled
      }
     else
      { require Exporter
      ; our @ISA = 'Exporter'
      ; our @EXPORT_OK  = qw| NEXT_HANDLER
                              LAST_HANDLER
                            |
      ; $pkg->export_to_level(1, @_)
      }
   }

; sub new
   { my ($c) = shift
   ; my ($s) = @_
   ; $s = { @_ }                      # passing hash backward compatibility
          unless ref $s eq 'HASH'
   ; foreach ( keys %$s )             # passing -flag backward compatibility
      { $$s{$_} = delete $$s{-$_}
                  if s/^-//
      }
   ; foreach ( values %$s )           # each value should be an ARRAY ref
      { $_ = [ $_ ]
             unless ref eq 'ARRAY'
      }
   ; bless $s, $c
   ; $$s{markers}         ||= $s->DEFAULT_MARKERS
   ; $$s{output_handlers} ||= $s->DEFAULT_PRINT_HANDLERS
   ; $$s{text_handlers}   ||= $s->DEFAULT_TEXT_HANDLERS
                              || $$s{output_handlers}
   ; $$s{zone_handlers}   ||= $s->DEFAULT_ZONE_HANDLERS
   ; $$s{value_handlers}  ||= $s->DEFAULT_VALUE_HANDLERS
   ; $$s{post_handlers}   ||= $s->DEFAULT_POST_HANDLERS
   ; $$s{lookups}         ||= [ (caller)[0] ]
   ; $$s{options}         ||= $s->DEFAULT_OPTIONS
   ; $$s{options}           = { map { /^(no_)*(.+)$/
                                    ; $2 => $1 ? 0 : 1
                                    }
                                    @{$$s{options}}
                              }
   ; foreach my $n qw| zone
                       value
                       text
                       output
                       post
                     |
      { $$s{$n.'_handlers'}
        &&= [ $s->_Hload( $$s{$n.'_handlers'}
                        , $n
                        )
            ]
      }
   ; $s
   }

; sub _Hload
   { my ($s, $arr, $n) = @_
   ; map
      { if ( ref eq 'CODE' )
         { $_
         }
        elsif ( not ref )
         { my $C = $s->can($_)
                || $s->can( join ( '_'
                                 , $_
                                 , uc $n
                                 , 'HANDLERS'
                                 )
                          )
                || croak qq(Unknown handler "$_")
         ; my $ref = $s->$C
         ; if ( ref $ref eq 'ARRAY' )
            { $s->_Hload( $ref, $n )
            }
           elsif ( ref $ref eq 'CODE' )
            { $ref
            }
         }
      }
      @$arr
   }

; sub _re
   { my ($s) = @_
   ; unless ( $$s{_re} ) # execute it just the first time AND if it has to parse
      { unless ( @{$$s{markers}} == 3 )
         { no strict 'refs' 
         ; my $m = $$s{markers}[0]
         ; my $M =  $s->can($m)
                 || $s->can($m.'_MARKERS') # backward compatibility
                 || croak qq(Unknown markers "$m")
         ; $$s{markers} = $s->$M
         }
      ; $$s{markers} = [ map { qr/$_/s