pixmicat - Blame information for rev 461

Subversion Repositories:
Rev:
Rev Author Line No. Line
436 roytam1 1 # Pixmicat! Template-Embedded Library v070618 (Perl port)
2 # Copyright(C) 2005-2007 Pixmicat! Development Team
3 # PHP version by: scribe & RT
4 # Perl Port by RT
5 # $Id: PTE.pm 438 2007-06-18 13:59:13Z roytam1 $
6 #
7 # Pixmicat! Template-Embedded Library (PTE) is released under The Clarified
8 # Artistic License.
9 # A more detailed definition of the terms please refer to the attached
10 # "LICENSE" file. If you do not receive the program with The Artistic License
11 # copy, please visit http://pixmicat.openfoundry.org/license/ to obtain a copy.
12  
13 # class PTE
14 package PTE;
15  
16 # exported functions
17 @EXPORT_OK = qw(ParseBlock BlockValue EvalIF EvalFOREACH EvalInclude);
18  
19 # constructor - read template file
20 # parameter 1 - template file name
21 sub new {
22         my $invocant = shift; # Class name
23         my $class   = ref($invocant) || $invocant; # Object or class name
24         my $tplfile = shift; # template name
25  
26         open(FH, $tplfile) || die("Error: $!");
27         my @tpl_data = <FH>;
28         close(FH);
29  
30         my $this = {
31                 tpl => join("",@tpl_data),
32                 tpl_block  => (),
33         };
34         return bless $this, $class;
35 }
36  
37 # readBlock - get Block from template data
38 # parameter 1 - block name
39 sub readBlock {
40         my ( $this, $blockName ) = @_;
41         if(!defined $this->{tpl_block}{$blockName}){ # found before?
42                 if($this->{tpl} =~ /<\!--&($blockName)-->(.*?)<!--\/&\1-->/sm) {
43                         $this->{tpl_block}{$blockName} = $2; # place it in hash
44                 } else {
45                         $this->{tpl_block}{$blockName} = undef; # not found
46                 }
47         }
48         return $this->{tpl_block}{$blockName};
49 }
50  
51 # BlockValue - get trimmed block
52 sub BlockValue {
53         my ( $this, $blockName ) = @_;
54         return $this->trim($this->readBlock($blockName));
55 }
56  
57 # ParseBlock - Parse the block and replace statements and variables, output parsed string
58 # parameter 1 - block name
59 # parameter 2 - reference hash of arguments
60 sub ParseBlock {
61         my ( $this, $blockName, $ary_val ) = @_;
62         my $tmp_block = $this->readBlock($blockName);
63         if(!$tmp_block) { return ""; } # not found
64         $tmp_block = $this->EvalFOREACH($tmp_block, $ary_val); # eval FOREACH statements
65         $tmp_block = $this->EvalIF($tmp_block, $ary_val); # eval IF statements
66         $tmp_block = $this->EvalInclude($tmp_block, $ary_val); # eval Includes
67         return $this->str_array_replace([keys %$ary_val], [values %$ary_val], $tmp_block); # replace variables
68 }
69  
70 # EvalIF - evaluate IF statements, output parsed string
71 # parameter 1 - block
72 # parameter 2 - reference hash of arguments
73 sub EvalIF {
74         my ( $this, $tpl, $ary ) = @_;
75         my $tmp_tpl = $tpl;
76         my @vari = my @isblock = my @statement = my @iftrue = my @iffalse = ();
77         my $ifres = '';
78         while($tmp_tpl =~ /<\!--&IF\(([\$&].*?),'(.*?)','(.*?)'\)-->/smg){ # separating search and replace part because it will cause pointer reset
79                 push @statement, $&; push @isblock, (substr($1,0,1) eq '&'); push @vari, substr($1,1); push @iftrue, $2; push @iffalse, $3;
80         }
81         for(my $i=0;$i<=$#statement;$i++) {
438 roytam1 82                 $tmp_tpl = $this->str_replace($statement[$i], (($isblock[$i] ? $this->BlockValue($vari[$i]) : ($$ary{'{$'.$vari[$i].'}'} ne ''))?$this->EvalInclude($iftrue[$i],$ary):$this->EvalInclude($iffalse[$i],$ary)), $tmp_tpl);
436 roytam1 83         }
84         return $tmp_tpl;
85 }
86 # EvalFOREACH - evaluate FOREACH statements, output parsed string
87 # parameter 1 - block
88 # parameter 2 - reference hash of arguments
89 sub EvalFOREACH {
90         my ( $this, $tpl, $ary ) = @_;
91         my $tmp_tpl = $tpl;
92         my @vari = my @statement = my @block = ();
93         my $eachvar;
94         while($tmp_tpl =~ /<\!--&FOREACH\((\$.*?),\'(.*?)\'\)-->/smg){
95                 push @statement, $&; push @vari, $1; push @block, $2;
96         }
97         my $foreach_tmp = '';
98         for(my $i=0;$i<=$#vari;$i++) {
99                 if(defined($$ary{'{'.$vari[$i].'}'}) && ref($$ary{'{'.$vari[$i].'}'}) eq 'ARRAY') {
100                         foreach $eachvar (@{$$ary{'{'.$vari[$i].'}'}}) {
101                                 $foreach_tmp .= $this->ParseBlock($block[$i], $eachvar);
102                         }
103                 }
104                 $tmp_tpl = $this->str_replace($statement[$i], $foreach_tmp, $tmp_tpl);
105         }
106         return $tmp_tpl;
107 }
108 # EvalInclude - evaluate Includes, output parsed string
109 # parameter 1 - block
110 # parameter 2 - reference hash of arguments
111 sub EvalInclude {
112         my ( $this, $tpl, $ary ) = @_;
113         my $tmp_tpl = $tpl;
114         my @statement = my @block = ();
115         while($tmp_tpl =~ /<\!--&([^\(\)']*)\/-->/smg) {
116                 push @statement, $&; push @block, $1;
117         }
118         for(my $i=0;$i<=$#block;$i++) {
119                 $tmp_tpl = $this->str_replace($statement[$i], $this->ParseBlock($block[$i], $ary), $tmp_tpl);
120         }
121         return $tmp_tpl;
122 }
123  
124 # str_array_replace - Perl equivalent of PHP's str_replace(array,array,string)
125 # parameter 1 - reference array of search strings
126 # parameter 2 - reference array of replace strings
127 # parameter 3 - target string
128 sub str_array_replace {
129         my ($this, $search, $replace, $string) = @_;
130  
131         for(my $i=0;$i<=$#$search;$i++) {
132                 $string = $this->str_replace($$search[$i], $$replace[$i], $string);
133         }
134  
135         return $string;
136 }
137  
138 # str_array_replace - Perl equivalent of PHP's str_replace(string,string,string)
139 # parameter 1 - search string
140 # parameter 2 - replace string
141 # parameter 3 - target string
142 sub str_replace {
143         my ($this, $search, $replace, $string) = @_;
144  
145         $string =~ s/\Q$search/$replace/g; # \Q = take away regular expression's power of $search
146  
147         return $string;
148 }
149  
150 # trim - Perl equivalent of PHP's trim
151 # parameter 1 - target string
152 sub trim {
153         my ($this, $string) = @_;
154         $string =~ s/^\s+//;
155         $string =~ s/\s+$//;
156         return $string;
157 }