File Coverage

blib/lib/WebDyne/Template.pm
Criterion Covered Total %
statement 17 110 15.4
branch 0 20 0.0
condition 1 39 2.5
subroutine 6 10 60.0
pod 0 4 0.0
total 24 183 13.1


line stmt bran cond sub pod time code
1             #
2             #
3             # Copyright (C) 2006-2010 Andrew Speer . All rights
4             # reserved.
5             #
6             # This file is part of WebDyne::Template.
7             #
8             # WebDyne::Template is free software; you can redistribute it and/or modify
9             # it under the terms of the GNU General Public License as published by
10             # the Free Software Foundation; either version 2 of the License, or
11             # (at your option) any later version.
12             #
13             # This program is distributed in the hope that it will be useful,
14             # but WITHOUT ANY WARRANTY; without even the implied warranty of
15             # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16             # GNU General Public License for more details.
17             #
18             # You should have received a copy of the GNU General Public License
19             # along with this program; if not, write to the Free Software
20             # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
21             #
22             #
23             package WebDyne::Template;
24              
25              
26             # Compiler Pragma
27             #
28 1     1   26139 use strict qw(vars);
  1         2  
  1         34  
29 1     1   6 use vars qw($VERSION);
  1         2  
  1         55  
30              
31              
32             # Webmod Modules.
33             #
34 1     1   969 use WebDyne::Constant;
  1         38614  
  1         588  
35 1     1   13 use WebDyne::Base;
  1         2  
  1         9  
36              
37              
38             # External modules
39             #
40 1     1   158 use File::Spec;
  1         2  
  1         1633  
41              
42              
43             # Version information in a formate suitable for CPAN etc. Must be
44             # all on one line
45             #
46             $VERSION='1.023';
47              
48              
49             # Debug
50             #
51             0 && debug("%s loaded, version $VERSION", __PACKAGE__);
52              
53              
54             # And done
55             #
56             1;
57              
58             #------------------------------------------------------------------------------
59              
60              
61             sub import {
62              
63              
64             # Will only work if called from within a __PERL__ block in WebDyne
65             #
66 1     1   13 my ($class, @param)=@_;
67 1   50     28 my $self_cr=UNIVERSAL::can(scalar caller, 'self') || return;
68 0   0       my $self=$self_cr->() || return;
69 0           $self->set_handler('WebDyne::Chain');
70             #$self->set_handler('WebDyne::Template');
71 0 0         my %param=(@param==1) ? (webdynetemplate => @param) : @param;
72 0           my $meta_hr=$self->meta();
73 0           push @{$meta_hr->{'webdynechain'}}, __PACKAGE__;
  0            
74 0           push @{$meta_hr->{'webdynefilter'}}, __PACKAGE__;
  0            
75 0           map { $meta_hr->{lc($_)}=$param{$_} } keys %param;
  0            
76              
77             }
78              
79              
80             sub handler : method {
81              
82              
83             # Add ourselves as a filter
84             #
85 0     0 0   my ($self, $r)=(shift, shift);
86 0           $self->set_filter(__PACKAGE__);
87 0           $self->SUPER::handler($r, @_);
88              
89             }
90              
91              
92             sub template {
93              
94              
95             # Name of template in use. Cannot be set here, too late - read only
96             #
97 0     0 0   my $self=shift();
98 0   0       my $r=$self->r() || return err();
99 0   0       my $meta_hr=$self->meta() || return err();
100 0   0       my $template_cn=$meta_hr->{'webdynetemplate'} || $r->dir_config('WebDyneTemplate');
101 0 0         $template_cn || return err('no template file name specified %s !', Data::Dumper::Dumper($meta_hr));
102              
103             # Must be full path, if not use current dir
104             #
105 0 0         unless ((File::Spec->splitpath($template_cn))[1]) {
106              
107             # No dir, must use cwd
108             #
109 0           my $dn=(File::Spec->splitpath($r->filename()))[1];
110 0           $template_cn=File::Spec->catfile($dn, $template_cn);
111              
112             }
113 0           \$template_cn
114              
115             }
116              
117              
118             sub source_mtime {
119              
120              
121             # Get latest srce mtime for source file and template so engine can
122             # determine if cache is stale
123             #
124 0     0 0   my ($self, $srce_mtime)=@_;
125 0           0 && debug('menu source mtime');
126              
127              
128             # Get request object
129             #
130 0   0       my $r=$self->r() || return err();
131              
132              
133             # Get full path, mtime of menu template
134             #
135 0 0         my $template_cn=${ $self->template() || return err() };
  0            
136 0   0       my $template_mtime=(stat($template_cn))[9] ||
137             return err("could not stat $template_cn, $!");
138              
139              
140             # Get appropriate mtime
141             #
142 0 0         my $return_mtime=($srce_mtime > $template_mtime) ? $srce_mtime : $template_mtime;
143 0           0 && debug("returning mtime $return_mtime");
144              
145              
146             # Return whichever is greater
147             #
148 0           return \$return_mtime;
149              
150              
151             }
152              
153              
154             sub filter {
155              
156              
157             # The real guts. Wedge one HTML page into a wrapper page
158             #
159 0     0 0   my ($self, $data_main_ar, $meta_main_hr)=@_;
160 0           0 && debug("in $self filter");
161              
162              
163             # Get request object
164             #
165 0   0       my $r=$self->r() ||
166             return err('unable to get request object');
167              
168              
169             # Get the template path name
170             #
171 0 0         my $template_cn=${ $self->template() || return err() };
  0            
172 0           0 && debug("template_pn $template_cn, %s", ref($r));
173 0 0         $template_cn || return err('no template file name specified');
174              
175              
176             # If user is looking at template, don't try and
177             # recursively compile it for them, bad things happen,
178             # just show as is
179             #
180 0 0         ($template_cn eq $r->filename()) &&
181             return $data_main_ar;
182              
183              
184             # Get the template structure data ref
185             #
186 0   0       my $container_ar=$self->compile({
187              
188             srce => $template_cn,
189             stage1 => 1,
190              
191             }) || return err();
192 0           my ($meta_template_hr, $data_template_ar)=@{$container_ar};
  0            
193              
194              
195             # Concatenate meta perl sections
196             #
197             #my $perl_main_ar=$meta_main_hr->{'perl'};
198 0           my $perl_template_ar=$meta_template_hr->{'perl'};
199 0           push @{$meta_main_hr->{'perl'}}, @{$perl_template_ar};
  0            
  0            
200 0           my $perl_debug_template_ar=$meta_template_hr->{'perl_debug'};
201 0           push @{$meta_main_hr->{'perl_debug'}}, @{$perl_debug_template_ar};
  0            
  0            
202              
203              
204             # Concatenate manifest sections
205             #
206 0           my $srce_template_ar=$meta_template_hr->{'manifest'};
207 0           push @{$meta_main_hr->{'manifest'}}, @{$srce_template_ar};
  0            
  0            
208              
209              
210             # Below fixes up HEAD section
211             #
212              
213              
214             # Find body block, ie tag in data ref
215             #
216 0   0       my $data_template_head_ar=($self->find_node({
217              
218             data_ar => $data_template_ar,
219             tag => 'head'
220              
221             }) || return err())->[0];
222 0           0 && debug("data_template_head_ar $data_template_head_ar %s", Dumper($data_template_head_ar));
223              
224              
225              
226             # Find the *parent* of the tag in the menu code. Note that this
227             # block in not necessarily immediately under the tag, may be buried
228             # further down under a table etc
229             #
230 0   0       my $data_template_head_block_prnt_ar=($self->find_node({
231              
232             data_ar => $data_template_head_ar,
233             tag => 'block',
234             attr_hr => { name=>'head' },
235             prnt_fg => 1,
236              
237             }) || return err())->[0];
238 0           0 && debug("data_template_head_block_prnt_ar $data_template_head_block_prnt_ar %s",
239             Dumper($data_template_head_block_prnt_ar));
240              
241              
242             # Get the actual data ref
243             #
244 0   0       my $data_template_head_block_ar=($self->find_node({
245              
246             data_ar => $data_template_ar,
247             tag => 'block',
248             attr_hr => { name=>'head' }
249              
250             }) || return err())->[0];
251 0           0 && debug("data_template_head_block_ar $data_template_head_block_ar %s",
252             Dumper($data_template_head_block_ar));
253              
254              
255             # Get the section from the main HTML page, ie the page to be
256             # embedded
257             #
258 0   0       my $data_main_head_ar=($self->find_node({
259              
260             data_ar => $data_main_ar,
261             tag => 'head'
262              
263             }) || return err())->[0];
264 0           0 && debug("data_main_head_ar $data_main_head_ar %s",
265             Dumper($data_main_head_ar));
266              
267              
268             # Concatenate titles
269             #
270 0   0       my $data_main_title_ar=($self->find_node({
271              
272             data_ar => $data_main_ar,
273             tag => 'title'
274              
275             }) || return err())->[0];
276 0   0       my $data_template_title_ar=($self->find_node({
277              
278             data_ar => $data_template_ar,
279             tag => 'title'
280              
281             }) || return err())->[0];
282 0           $data_main_title_ar->[$WEBDYNE_NODE_CHLD_IX][0]=join(' - ', grep {$_}
  0            
283             $data_template_title_ar->[$WEBDYNE_NODE_CHLD_IX][0],$data_main_title_ar->[$WEBDYNE_NODE_CHLD_IX][0]);
284             #0 && debug('titles, %s, %s', Dumper($data_main_title_ar, $data_template_title_ar));
285              
286              
287             # Replace menu head attr with any head attr from main page
288             #
289 0           $data_template_head_ar->[$WEBDYNE_NODE_ATTR_IX]=
290             $data_main_head_ar->[$WEBDYNE_NODE_ATTR_IX];
291              
292              
293             # Search for head block in head block parent
294             #
295 0           foreach my $data_chld_ix (0 .. $#{$data_template_head_block_prnt_ar->[$WEBDYNE_NODE_CHLD_IX]}) {
  0            
296              
297              
298             # Skip if not found
299             #
300 0           my $data_chld_ar=$data_template_head_block_prnt_ar->[$WEBDYNE_NODE_CHLD_IX][$data_chld_ix];
301 0 0         next unless ($data_chld_ar eq $data_template_head_block_ar);
302              
303              
304             # Must have found node if get to here, splice in head
305             #
306 0           splice @{$data_template_head_block_prnt_ar->[$WEBDYNE_NODE_CHLD_IX]},$data_chld_ix,1,
  0            
307 0           @{$data_main_head_ar->[$WEBDYNE_NODE_CHLD_IX]};
308 0           last;
309              
310             }
311              
312              
313             # Below fixes up BODY section
314             #
315              
316              
317             # Find body block, ie tag in data ref
318             #
319 0   0       my $data_template_body_ar=($self->find_node({
320              
321             data_ar => $data_template_ar,
322             tag => 'body'
323              
324             }) || return err())->[0];
325 0           0 && debug("data_template_body_ar $data_template_body_ar %s", Dumper($data_template_body_ar));
326              
327              
328              
329             # Find the *parent* of the tag in the menu code. Note that this
330             # block in not neccessarily immediately under the tag, may be buried
331             # further down under a table etc
332             #
333 0   0       my $data_template_body_block_prnt_ar=($self->find_node({
334              
335             data_ar => $data_template_body_ar,
336             tag => 'block',
337             attr_hr => { name=>'body' },
338             prnt_fg => 1,
339              
340             }) || return err())->[0];
341 0           0 && debug("data_template_body_block_prnt_ar $data_template_body_block_prnt_ar %s",
342             Dumper($data_template_body_block_prnt_ar));
343              
344              
345             # Get the actual data ref
346             #
347 0   0       my $data_template_body_block_ar=($self->find_node({
348              
349             data_ar => $data_template_ar,
350             tag => 'block',
351             attr_hr => { name=>'body' }
352              
353             }) || return err())->[0];
354 0           0 && debug("data_template_body_block_ar $data_template_body_block_ar %s",
355             Dumper($data_template_body_block_ar));
356              
357              
358             # Get the section from the main HTML page, ie the page to be
359             # embedded
360             #
361 0   0       my $data_main_body_ar=($self->find_node({
362              
363             data_ar => $data_main_ar,
364             tag => 'body'
365              
366             }) || return err())->[0];
367 0           0 && debug("data_main_body_ar $data_main_body_ar %s",
368             Dumper($data_main_body_ar));
369              
370              
371             # Replace menu body attr with any body attr from main page
372             #
373 0           $data_template_body_ar->[$WEBDYNE_NODE_ATTR_IX]=
374             $data_main_body_ar->[$WEBDYNE_NODE_ATTR_IX];
375              
376              
377             # Search for body block in body block parent
378             #
379 0           foreach my $data_chld_ix (0 .. $#{$data_template_body_block_prnt_ar->[$WEBDYNE_NODE_CHLD_IX]}) {
  0            
380              
381              
382             # Skip if not found
383             #
384 0           my $data_chld_ar=$data_template_body_block_prnt_ar->[$WEBDYNE_NODE_CHLD_IX][$data_chld_ix];
385 0 0         next unless ($data_chld_ar eq $data_template_body_block_ar);
386              
387              
388             # Must have found node if get to here, splice in body
389             #
390 0           splice @{$data_template_body_block_prnt_ar->[$WEBDYNE_NODE_CHLD_IX]},$data_chld_ix,1,
  0            
391 0           @{$data_main_body_ar->[$WEBDYNE_NODE_CHLD_IX]};
392 0           last;
393              
394              
395             }
396              
397              
398             # All done, pass onto next filter
399             #
400 0           return $data_template_ar;
401              
402             }
403              
404              
405             __END__