1
2
3# = HISTORY SECTION =====================================================================
4
5# ---------------------------------------------------------------------------------------
6# version | date     | author   | changes
7# ---------------------------------------------------------------------------------------
8# 0.01    |08.07.2004| JSTENZEL | new.
9# ---------------------------------------------------------------------------------------
10
11# = POD SECTION =========================================================================
12
13=head1 NAME
14
15B<PerlPoint::Template> - PerlPoint template handler
16
17=head1 VERSION
18
19This manual describes version B<0.01>.
20
21=head1 SYNOPSIS
22
23
24
25=head1 DESCRIPTION
26
27
28=head1 METHODS
29
30=cut
31
32
33
34
35# check perl version
36require 5.00503;
37
38# = PACKAGE SECTION (internal helper package) ==========================================
39
40# declare package
41package PerlPoint::Template;
42
43# declare package version and author
44$VERSION=0.01;
45$AUTHOR=$AUTHOR='J. Stenzel (perl@jochen-stenzel.de), 2004';
46
47
48# = PRAGMA SECTION =======================================================================
49
50# set pragmata
51use strict;
52
53# declare object data fields
54use fields qw(
55              generator
56              options
57             );
58
59
60# = LIBRARY SECTION ======================================================================
61
62# load modules
63use Carp;
64use File::Copy;
65use File::Basename;
66
67
68# = CODE SECTION =========================================================================
69
70
71=pod
72
73=head2 new()
74
75
76B<Parameters:>
77
78=over 4
79
80=item class
81
82The class name.
83
84=back
85
86B<Returns:> the new object.
87
88B<Example:>
89
90
91=cut
92sub new
93 {
94  # get parameter
95  my ($class, %params)=@_;
96
97  # check parameters
98  confess "[BUG] Missing class name.\n" unless $class;
99  confess "[BUG] Missing generator parameter.\n" unless exists $params{generator};
100  confess "[BUG] Generator parameter is no PerlPoint::Generator object.\n" unless $params{generator}->is('PerlPoint::Generator');
101  confess "[BUG] This method should be called via its own package only.\n" unless $class eq __PACKAGE__;
102
103  # get options
104  my $options=$params{generator}->options();
105
106  # check environment: style specified?
107  die "[Fatal] Templates cannot be used without a style, please set -style.\n" unless exists $options->{style} or exists $options->{help};
108
109  # check environment: template prepared to handle our target language?
110  die "[Fatal] Please use option -templatesAccept to specify which targets are handled by your templates.\n" unless exists $options->{templatesAccept};
111  {
112   my %acceptedTargets;
113   @acceptedTargets{@{$options->{templatesAccept}}}=();
114   die "[Fatal] $options->{formatter} formatted target $options->{target} ist not supported by the templates in style $options->{style}.\n"
115     unless exists $acceptedTargets{"$options->{target}/$options->{formatter}"};
116  }
117
118  # declarations
119  my __PACKAGE__ $plugin;
120
121  # check for a template directory in the current style
122  unless (exists $options->{help} or -d "$params{generator}{cfg}{setup}{stylepath}/$options->{style}/templates")
123    {die "[Fatal] No template directory in style $options->{style}.\n";}
124  else
125    {
126     # try to load the template class
127     my $pluginClass=join('::', __PACKAGE__, $options->{templatetype});
128     eval "require $pluginClass" or die "[Fatal] Missing template engine class $pluginClass, please install it ($@).\n";
129     die $@ if $@;
130
131     # build our object as an instance of the *plugin* class and check it
132     $plugin=$pluginClass->new();
133     confess "[BUG] Template class $pluginClass does not inherit from ", __PACKAGE__, ".\n" unless $plugin->isa(__PACKAGE__);
134
135     # check API
136     foreach (qw(declareOptions bootstrap transform))
137       {die "[BUG] Template class $pluginClass does not not provide required method $_().\n" unless $plugin->can($_);}
138    }
139
140  # init attributes
141  $plugin->{generator}=$params{generator};
142  $plugin->{options}=$options;             # this is a copy by intention (templates cannot overwrite originals!)
143
144  # supply new object
145  $plugin;
146 }
147
148
149# bootstrap
150sub bootstrap
151 {
152  # get and check parameters
153  (my __PACKAGE__ $me)=@_;
154  confess "[BUG] Missing object parameter.\n" unless $me;
155  confess "[BUG] Object parameter is no ", __PACKAGE__, " object.\n" unless ref $me and $me->isa(__PACKAGE__);
156
157  # perform usage checks
158  $me->checkUsage or die;
159
160  # copy image files, if necessary
161  my $dir=join('/', $me->{generator}{cfg}{setup}{stylepath}, $me->options->{style}, 'templates');
162  foreach my $file (<$dir/*.gif>, <$dir/*.jpg>, <$dir/*.png>)
163    {
164     # get basename
165     my $basename=basename($file);
166
167     # copy file, if necessary
168     if (
169             not -e "$me->{generator}{options}{targetdir}/$basename"
170         or -M "$me->{generator}{options}{targetdir}/$basename" > -M $file
171        )
172       {
173        warn "[Info] Copying template image file $file to target directory $me->{generator}{options}{targetdir}.\n";
174        copy($file, $me->{generator}{options}{targetdir}) or die "[Fatal] Could not copy $file to $me->{generator}{options}{targetdir}.\n";
175       }
176    }
177 }
178
179
180# check usage
181sub checkUsage
182 {
183  # currently this is a fallback in case child classes do not define it on their own
184  1;
185 }
186
187# provide generator object
188sub generator
189 {
190  # get and check parameters
191  (my __PACKAGE__ $me)=@_;
192  confess "[BUG] Missing object parameter.\n" unless $me;
193  confess "[BUG] Object parameter is no ", __PACKAGE__, " object.\n" unless ref $me and $me->isa(__PACKAGE__);
194
195  # provide the aggregated object
196  $me->{generator};
197 }
198
199
200# provide options (the module itself does not provide any options at the moment, but in case
201# all derived classes don't this is well and do not define this method, this method here
202# serves as a fallback so that objects of the Template hierarchy always can call options())
203sub options
204 {
205  # get and check parameters
206  (my __PACKAGE__ $me)=@_;
207  confess "[BUG] Missing object parameter.\n" unless $me;
208  confess "[BUG] Object parameter is no ", __PACKAGE__, " object.\n" unless ref $me and $me->isa(__PACKAGE__);
209
210  # provide data (we don't add anything to the base options)
211  $me->{options};
212 }
213
214
215# provide help portions
216sub help
217 {
218  # to get a flexible tool, help texts are supplied in portions
219  {
220   # supply the options part
221   OPTIONS => {
222              },
223
224   # supply synopsis part
225   SYNOPSIS => join("\n\n", "\n\n=head2 Templates", <<EOS), # complicated to pass PAR (pp)
226
227Templates allow to specify common page (part) patterns, specialized for certain pages via
228keywords or functions. Various templating systems are around, and it is basically possible
229to use I<each> of them in conjunction with PerlPoint. Nevertheless, there need to be "engine"
230modules available, which help to pass data back and forth between the PerlPoint system and
231your templates.
232
233EOS
234  }
235 }
236
237
238# common preprocessing: provide usually used data in a template independent data structure
239sub preprocessData
240 {
241  # get and check parameters
242  ((my __PACKAGE__ $me), my ($page))=@_;
243  confess "[BUG] Missing object parameter.\n" unless $me;
244  confess "[BUG] Object parameter is no ", __PACKAGE__, " object.\n" unless ref $me and $me->isa(__PACKAGE__);
245  confess "[BUG] Missing page data parameter.\n" unless $page;
246
247  # declare variables
248  my ($rc);
249
250  # get options
251  my $options=$me->options;
252
253  # get page number
254  $rc->{pageNr}=$me->numberOfChapters();
255
256  # get data of the first page
257  $rc->{fNumber}=$me->pageBySpec('first', $page);
258  $rc->{fPage}=$me->page($rc->{fNumber});
259  $rc->{fFile}=$me->buildFilename($rc->{fNumber});
260  $rc->{fText}=$rc->{fPage}->path(type=>'spath', mode=>'title');
261
262  # get data of the current page
263  $rc->{cPage}=$me->page($page);
264  $rc->{cFile}=$me->buildFilename($page);
265  $rc->{cText}=$rc->{cPage}->path(type=>'spath', mode=>'title');
266  $rc->{cVars}=$rc->{cPage}->vars();
267
268  # get data of the parent page (one level above)
269  $rc->{uNumber}=$me->pageBySpec('up', $page);
270  $rc->{uPage}=$me->page($rc->{uNumber});
271  $rc->{uFile}=$me->buildFilename($rc->{uNumber}) || '';
272  $rc->{uText}=defined $rc->{uPage} ? $rc->{uPage}->path(type=>'spath', mode=>'title') : '';
273
274  # get data of the previous page
275  $rc->{pNumber}=$me->pageBySpec('previous', $page);
276  $rc->{pPage}=$me->page($rc->{pNumber});
277  $rc->{pFile}=$me->buildFilename($rc->{pNumber}) || '';
278  $rc->{pText}=defined $rc->{pPage} ? $rc->{pPage}->path(type=>'spath', mode=>'title') : '';
279  $rc->{pVars}=defined $rc->{pPage} ? $rc->{pPage}->vars() : {};
280
281  # get data of the next page
282  $rc->{nNumber}=$me->pageBySpec('next', $page);
283  $rc->{nPage}=$me->page($rc->{nNumber});
284  $rc->{nFile}=$me->buildFilename($rc->{nNumber}) || '';
285  $rc->{nText}=defined $rc->{nPage} ? $rc->{nPage}->path(type=>'spath', mode=>'title') : '';
286
287  # get data of the last page
288  $rc->{lNumber}=$me->pageBySpec('last', $page);
289  $rc->{lPage}=$me->page($rc->{lNumber});
290  $rc->{lFile}=$me->buildFilename($rc->{lNumber});
291  $rc->{lText}=$rc->{lPage}->path(type=>'spath', mode=>'title');
292
293  # prebuild more replacement strings
294  $rc->{doctitle}=$me->{generator}{options}{doctitle};
295  $rc->{title}=$rc->{cPage}->path(type=>'fpath', mode=>'title');
296  $rc->{tocFile}=$me->buildFilename('toc');
297  $rc->{indexFile}=$me->buildFilename('index');
298
299  # the page path has to be produced with links
300  my $cc=0;
301  my $pnArray=$rc->{cPage}->path(type=>'ppath', mode=>'array');
302  my $csArray=$rc->{cPage}->path(type=>'spath', mode=>'array');
303  $rc->{cPath}=[(exists $me->{options}{bootstrapaddress} ? [$me->{options}{bootstrapaddress}, 'Start'] : ()), map {[basename($me->buildFilename($pnArray->[$cc++])), $_];} @$csArray[0 .. $#{$csArray}-1]];
304
305  # supply data (does this need to become an object?)
306  $rc;
307 }
308
309
310
311# GENERATOR METHOD WRAPPERS ###########################################################
312
313# To simplify the usage of the template module, we provide wrappers for various
314# generator methods. Yes, this slows things down, but improves usability.
315
316sub numberOfChapters
317 {
318  # get and check parameters
319  (my __PACKAGE__ $me)=@_;
320  confess "[BUG] Missing object parameter.\n" unless $me;
321  confess "[BUG] Object parameter is no ", __PACKAGE__, " object.\n" unless ref $me and $me->isa(__PACKAGE__);
322
323  # pass call through
324  shift;
325  $me->{generator}->numberOfChapters(@_);
326 }
327
328sub pageBySpec
329 {
330  # get and check parameters
331  (my __PACKAGE__ $me)=@_;
332  confess "[BUG] Missing object parameter.\n" unless $me;
333  confess "[BUG] Object parameter is no ", __PACKAGE__, " object.\n" unless ref $me and $me->isa(__PACKAGE__);
334
335  # pass call through
336  shift;
337  $me->{generator}->pageBySpec(@_);
338 }
339
340sub page
341 {
342  # get and check parameters
343  (my __PACKAGE__ $me)=@_;
344  confess "[BUG] Missing object parameter.\n" unless $me;
345  confess "[BUG] Object parameter is no ", __PACKAGE__, " object.\n" unless ref $me and $me->isa(__PACKAGE__);
346
347  # pass call through
348  shift;
349  $me->{generator}->page(@_);
350 }
351
352sub buildFilename
353 {
354  # get and check parameters
355  (my __PACKAGE__ $me)=@_;
356  confess "[BUG] Missing object parameter.\n" unless $me;
357  confess "[BUG] Object parameter is no ", __PACKAGE__, " object.\n" unless ref $me and $me->isa(__PACKAGE__);
358  confess "[BUG] Missing path arguments.\n" unless @_>1;
359
360  # pass call through
361  shift;
362  $me->{generator}->buildFilename(@_);
363 }
364
365
366
367
368# display a class specific copyright message
369sub _classCopyright
370 {
371  my ($class)=@_;
372
373  my $rootClass=__PACKAGE__;
374  $class=ref($class) if ref($class);
375  return '' unless $class and $class=~/^$rootClass/;
376
377  no strict 'refs';
378  (_classCopyright(@{join('::', $class, 'ISA')}), join('', $class, ' ', $class->VERSION, ' (c) ', ${join('::', $class, 'AUTHOR')}, ".\n"));
379 }
380
381
382
383
384# flag successful loading
3851;
386
387# = POD TRAILER SECTION =================================================================
388
389=pod
390
391=head1 NOTES
392
393
394=head1 SEE ALSO
395
396=over 4
397
398
399
400=back
401
402
403=head1 SUPPORT
404
405A PerlPoint mailing list is set up to discuss usage, ideas,
406bugs, suggestions and translator development. To subscribe,
407please send an empty message to perlpoint-subscribe@perl.org.
408
409If you prefer, you can contact me via perl@jochen-stenzel.de
410as well.
411
412=head1 AUTHOR
413
414Copyright (c) Jochen Stenzel (perl@jochen-stenzel.de), 2004.
415All rights reserved.
416
417This module is free software, you can redistribute it and/or modify it
418under the terms of the Artistic License distributed with Perl version
4195.003 or (at your option) any later version. Please refer to the
420Artistic License that came with your Perl distribution for more
421details.
422
423The Artistic License should have been included in your distribution of
424Perl. It resides in the file named "Artistic" at the top-level of the
425Perl source tree (where Perl was downloaded/unpacked - ask your
426system administrator if you dont know where this is).  Alternatively,
427the current version of the Artistic License distributed with Perl can
428be viewed on-line on the World-Wide Web (WWW) from the following URL:
429http://www.perl.com/perl/misc/Artistic.html
430
431
432=head1 DISCLAIMER
433
434This software is distributed in the hope that it will be useful, but
435is provided "AS IS" WITHOUT WARRANTY OF ANY KIND, either expressed or
436implied, INCLUDING, without limitation, the implied warranties of
437MERCHANTABILITY and FITNESS FOR A PARTICULAR PURPOSE.
438
439The ENTIRE RISK as to the quality and performance of the software
440IS WITH YOU (the holder of the software).  Should the software prove
441defective, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR
442CORRECTION.
443
444IN NO EVENT WILL ANY COPYRIGHT HOLDER OR ANY OTHER PARTY WHO MAY CREATE,
445MODIFY, OR DISTRIBUTE THE SOFTWARE BE LIABLE OR RESPONSIBLE TO YOU OR TO
446ANY OTHER ENTITY FOR ANY KIND OF DAMAGES (no matter how awful - not even
447if they arise from known or unknown flaws in the software).
448
449Please refer to the Artistic License that came with your Perl
450distribution for more details.
451
452