Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100755 626 lines (515 sloc) 20.041 kb
3ebfa07 @abw Initial revision
authored
1 #!/usr/bin/perl -w
2 #========================================================================
3 #
4 # ttree
5 #
6 # DESCRIPTION
7 # Script for processing all directory trees containing templates.
8 # Template files are processed and the output directed to the
9 # relvant file in an output tree. The timestamps of the source and
10 # destination files can then be examined for future invocations
11 # to process only those files that have changed. In other words,
12 # it's a lot like 'make' for templates.
13 #
14 # AUTHOR
82cbea8 @abw version 2.00
authored
15 # Andy Wardley <abw@kfs.org>
3ebfa07 @abw Initial revision
authored
16 #
17 # COPYRIGHT
82cbea8 @abw version 2.00
authored
18 # Copyright (C) 1996-2000 Andy Wardley. All Rights Reserved.
19 # Copyright (C) 1998-2000 Canon Research Centre Europe Ltd.
3ebfa07 @abw Initial revision
authored
20 #
21 # This module is free software; you can redistribute it and/or
22 # modify it under the same terms as Perl itself.
23 #
24 #------------------------------------------------------------------------
25 #
26 # $Id$
27 #
28 #========================================================================
29
30 use strict;
31 use Template;
32 use AppConfig qw( :expand );
33 use File::Copy;
34 use File::Path;
35 use File::Basename;
36
37
38 #------------------------------------------------------------------------
39 # config
40 #------------------------------------------------------------------------
41 my $NAME = "ttree";
42 my $VERSION = sprintf("%d.%02d", q$Revision$ =~ /(\d+)\.(\d+)/);
43 my $HOME = $ENV{ HOME } || '';
44 my $RCFILE = $ENV{"\U${NAME}rc"} || "$HOME/.${NAME}rc";
45
a314819 @abw v2.00
authored
46 # offer create a sample config file if it doesn't exist, unless a '-f'
47 # has been specified on the command line
48 unless (-f $RCFILE or grep(/^-f$/, @ARGV) ) {
3ebfa07 @abw Initial revision
authored
49 print("Do you want me to create a sample '.ttreerc' file for you?\n",
50 "(file: $RCFILE) [y/n]: ");
51 my $y = <STDIN>;
52 if ($y =~ /^y(es)?/i) {
53 write_config($RCFILE);
54 exit(0);
55 }
56 }
57
58 # read configuration file and command line arguments - I need to remember
59 # to fix varlist() and varhash() in AppConfig to make this nicer...
60 my $config = read_config($RCFILE);
61 my $dryrun = $config->nothing;
62 my $verbose = $config->verbose || $dryrun;
63 my $recurse = $config->recurse;
64 my $preserve = $config->preserve;
65 my $debug = $config->debug;
66 my $all = $config->all;
67 my $libdir = $config->lib;
68 my $ignore = $config->ignore;
69 my $copy = $config->copy;
70 my $accept = $config->accept;
71 my $srcdir = $config->src
72 || die "Source directory not set (-s)\n";
73 my $destdir = $config->dest
74 || die "Destination directory not set (-d)\n";
75 die "Source and destination directories may not be the same:\n $srcdir\n"
76 if $srcdir eq $destdir;
77
78 # unshift any perl5lib directories onto front of INC
79 unshift(@INC, @{ $config->perl5lib });
80
81 # get all template_* options from the config and fold keys to UPPER CASE
82 my %ttopts = $config->varlist('^template_', 1);
83 my %ucttopts;
84 @ucttopts{ map { uc } keys %ttopts } = values %ttopts;
85
d52480d @abw *** empty log message ***
authored
86 #print "TT config: ", join(', ', map { "$_ => $ucttopts{ $_ }"}
87 # keys %ucttopts), "\n";
88
e1ad160 @abw *** empty log message ***
authored
89 # get all template variable definitions
90 my $replace = $config->get('define');
d52480d @abw *** empty log message ***
authored
91
3e45060 @abw *** empty log message ***
authored
92 #print "replace hash: ", join(', ', map { "$_ => $replace->{ $_ }"}
93 # keys %$replace), "\n";
e1ad160 @abw *** empty log message ***
authored
94
3ebfa07 @abw Initial revision
authored
95 # now create complete parameter hash for creating template processor
96 my $ttopts = {
97 %ucttopts,
49d1e32 @abw *** empty log message ***
authored
98 RELATIVE => 1,
3ebfa07 @abw Initial revision
authored
99 INCLUDE_PATH => [ @$libdir, '.' ],
100 OUTPUT_PATH => $destdir,
101 };
102
103 #------------------------------------------------------------------------
104 # pre-amble
105 #------------------------------------------------------------------------
106 print "$NAME $VERSION (Template Toolkit version $Template::VERSION)\n\n"
107 if $verbose;
108
109 if ($verbose) {
110 local $" = ', ';
111 print(STDERR
112 " Source: $srcdir\n",
113 " Destination: $destdir\n",
114 "Include Path: [ @$libdir ]\n",
115 " Ignore: [ @$ignore ]\n",
116 " Copy: [ @$copy ]\n",
117 " Accept: [ ", @$accept ? "@$accept" : "*", " ]\n\n");
118 print(STDERR "NOTE: dry run, doing nothing...\n")
119 if $dryrun;
120 }
121 if ($debug) {
122 local $" = ', ';
123 print STDERR "Template Toolkit configuration:\n";
124 foreach (keys %ucttopts) {
125 my $val = $ucttopts{$_};
126 next unless $val;
127 if (ref($val) eq 'ARRAY') {
128 next unless @$val;
129 $val = "[ @$val ]";
130 }
131 printf STDERR " %-12s => $val\n", $_;
132 }
133 print STDERR "\n";
134 }
135
136
137 #------------------------------------------------------------------------
138 # main-amble
139 #------------------------------------------------------------------------
140
141 chdir($srcdir) || die "$srcdir: $!\n";
142
143 my $template = Template->new($ttopts);
144
145 if (@ARGV) {
146 # explicitly process files specified on command lines
147 foreach my $file (@ARGV) {
148 print " + $file\n" if $verbose;
e1ad160 @abw *** empty log message ***
authored
149 $template->process("$file", $replace, $file)
3ebfa07 @abw Initial revision
authored
150 || print " ! ", $template->error(), "\n";
151 }
152 }
153 else {
154 # implicitly process all file in source directory
155 process_tree();
156 }
157
158
159 #------------------------------------------------------------------------
160 # process_tree($dir)
161 #
162 # Walks the directory tree starting at $dir or the current directory
163 # if unspecified, processing files as found.
164 #------------------------------------------------------------------------
165
166 sub process_tree {
167 my $dir = shift;
168 my ($file, $path, $check);
169 my $target;
170 local *DIR;
171
172 opendir(DIR, $dir || '.') || return undef;
173
174 FILE: while (defined ($file = readdir(DIR))) {
175 next if $file eq '.' || $file eq '..';
176 $path = $dir ? "$dir/$file" : $file;
177 next unless -e $path;
178
179 # check against ignore list
180 foreach $check (@$ignore) {
181 if ($path =~ /$check/) {
182 printf " - %-32s (ignored, matches /$check/)\n", $file
183 if $verbose;
184 next FILE;
185 }
186 }
187
188 if (-d $path) {
189 if ($recurse) {
190 my ($uid, $gid, $mode);
191
192 (undef, undef, $mode, undef, $uid, $gid, undef, undef,
193 undef, undef, undef, undef, undef) = stat($path);
194
195 # create target directory if required
196 $target = "$destdir/$path";
197 unless (-d $target || $dryrun) {
198 mkdir $target, $mode || do {
199 warn "mkdir($target): $!\n";
200 next;
201 };
202 chown($uid, $gid, $target) || warn "chown($target): $!\n";
203 printf " + %-32s (created target directory)\n", $path
204 if $verbose;
205 }
206 # recurse into directory
207 process_tree($path);
208 }
209 else {
210 printf " - %-32s (directory, not recursing)\n", $path
211 if $verbose;
212 }
213 }
214 else {
215 process_file($path);
216 }
217 }
218 closedir(DIR);
219 }
220
221
222 #------------------------------------------------------------------------
223 # process_file()
224 #
225 # File filtering and processing sub-routine called by process_tree()
226 #------------------------------------------------------------------------
227
228 sub process_file {
229 my $file = shift;
230 my ($dest, $base, $check, $srctime, $desttime, $mode, $uid, $gid);
231
232 $dest = $destdir ? "$destdir/$file" : $file;
233 $base = basename($file);
234
235 # print "proc $file => $dest\n";
236
237 # stat the source file unconditionally, so we can preserve
238 # mode and ownership
239 (undef, undef, $mode, undef, $uid, $gid, undef, undef, undef, $srctime,
240 undef, undef, undef) = stat($file);
241
242 # test modification time of existing destination file
243 if (-f $dest && ! $all) {
244 $desttime = ( stat($dest) )[9];
245
246 if ($desttime > $srctime) {
247 printf " - %-32s (not modified)\n", $file
248 if $verbose;
249 return;
250 }
251 }
252
253 # check against copy list
254 foreach $check (@$copy) {
255 if ($base =~ /$check/) {
256 printf " > %-32s (copied, matches /$check/)\n", $file
257 if $verbose;
258
259 unless ($dryrun) {
260 copy($file, $dest);
261
262 if ($preserve) {
263 chown($uid, $gid, $dest) || warn "chown($dest): $!\n";
264 chmod($mode, $dest) || warn "chmod($dest): $!\n";
265 }
266 }
267 return;
268 }
269 }
270
271 # check against acceptance list
272 if (@$accept) {
273 unless (grep { $base =~ /$_/ } @$accept) {
274 printf " - %-32s (not accepted)\n", $file
275 if $verbose;
276 return;
277 }
278 }
279
280 print " + $file\n" if $verbose;
281
282 # process file
283 unless ($dryrun) {
e1ad160 @abw *** empty log message ***
authored
284 $template->process("./$file", $replace, $file)
3ebfa07 @abw Initial revision
authored
285 || print(" ! ", $template->error(), "\n");
286
287 if ($preserve) {
288 chown($uid, $gid, $dest) || warn "chown($dest): $!\n";
289 chmod($mode, $dest) || warn "chmod($dest): $!\n";
290 }
291 }
292 }
293
294
295 #------------------------------------------------------------------------
296 # read_config($file)
297 #
298 # Handles reading of config file and/or command line arguments.
299 #------------------------------------------------------------------------
300
301 sub read_config {
302 my $file = shift;
303
304 my $config = AppConfig->new({
e1ad160 @abw *** empty log message ***
authored
305 ERROR => sub { die @_, "\ntry `$NAME --help'\n" } },
3ebfa07 @abw Initial revision
authored
306 'help|h' => { ACTION => \&help },
307 'src|s=s' => { EXPAND => EXPAND_ALL },
308 'dest|d=s' => { EXPAND => EXPAND_ALL },
309 'lib|l=s@' => { EXPAND => EXPAND_ALL },
310 'cfg|c=s' => { EXPAND => EXPAND_ALL, DEFAULT => '.' },
311 'verbose|v' => { DEFAULT => 0 },
312 'recurse|r' => { DEFAULT => 0 },
313 'nothing|n' => { DEFAULT => 0 },
314 'preserve|p' => { DEFAULT => 0 },
315 'all|a' => { DEFAULT => 0 },
316 'debug|dbg' => { DEFAULT => 0 },
e1ad160 @abw *** empty log message ***
authored
317 'define=s%',
3ebfa07 @abw Initial revision
authored
318 'ignore=s@',
319 'copy=s@',
320 'accept=s@',
d52480d @abw *** empty log message ***
authored
321 'template_anycase|anycase',
3ebfa07 @abw Initial revision
authored
322 'template_eval_perl|eval_perl',
323 'template_load_perl|load_perl',
324 'template_interpolate|interpolate',
325 'template_pre_chomp|pre_chomp|prechomp',
326 'template_post_chomp|post_chomp|postchomp',
49d1e32 @abw *** empty log message ***
authored
327 'template_trim|trim',
82cbea8 @abw version 2.00
authored
328 'template_pre_process|pre_process|preprocess=s@',
329 'template_post_process|post_process|postprocess=s@',
d52480d @abw *** empty log message ***
authored
330 'template_process|process=s',
331 'template_default|default=s',
332 'template_error|error=s',
3ebfa07 @abw Initial revision
authored
333 'template_start_tag|start_tag|starttag=s',
334 'template_end_tag|end_tag|endtag=s',
335 'template_tag_style|tag_style|tagstyle=s',
d52480d @abw *** empty log message ***
authored
336 'template_compile_ext|compile_ext=s',
337 'template_compile_dir|compile_dir=s',
3ebfa07 @abw Initial revision
authored
338 'template_plugin_base|plugin_base|pluginbase=s@',
339 'perl5lib|perllib=s@'
340 );
341
342 # add the 'file' option now that we have a $config object that we
343 # can reference in a closure
344 $config->define(
345 'file|f=s@' => { EXPAND => EXPAND_ALL,
346 ACTION => sub {
347 my ($state, $item, $file) = @_;
348 $file = $state->cfg . "/$file"
349 unless $file =~ /^[\.\/]/;
350 $config->file($file) }
351 }
352 );
353
354 # process main config file, then command line args
a314819 @abw v2.00
authored
355 $config->file($file) if -f $file;
3ebfa07 @abw Initial revision
authored
356 $config->args();
357
358 $config;
359 }
360
361
362 #------------------------------------------------------------------------
363 # write_config($file)
364 #
365 # Writes a sample configuration file to the filename specified.
366 #------------------------------------------------------------------------
367
368 sub write_config {
369 my $file = shift;
370
371 open(CONFIG, ">$file") || die "failed to create $file: $!\n";
372 print(CONFIG <<END_OF_CONFIG);
373 #------------------------------------------------------------------------
374 # sample .ttreerc file created automatically by $NAME version $VERSION
375 #
376 # This file originally written to $file
377 #
378 # For more information on the contents of this configuration file, see
379 #
380 # perldoc ttree
381 # ttree -h
382 #
383 # NOTE: The directories specified below adopt the UNIX convention of
384 # specifying a user's home directory with the '~' character. This
385 # feature may not be available on other platforms in which case you
386 # should specify the directory in entirety.
387 #------------------------------------------------------------------------
388
389 #------------------------------------------------------------------------
390 # General options
391
392 # print summary of what's going on (-v)
393 verbose
394
395 # recurse into any sub-directories and process files (-r)
396 recurse
397
398
399 #------------------------------------------------------------------------
400 # The 'cfg' option defines a directory in which other ttree configuration
401 # files can be found; you can specify a file using the '-f' option,
402 # 'ttree -f myconfig' and the script will look for the file in this
403 # directory. Alteratively, provide an absolute path as an argument,
404 # 'ttree -f /tmp/foo'.
405 #
406 # By default, this option is commented out. You will need to create a
407 # directory, uncomment the following line and set the value appropriately.
408 # Having done that, you can then create files exactly like this in that
409 # location.
410
411 #cfg = ~/.ttree
412
413 #------------------------------------------------------------------------
414 # The remaining options define the default behaviour when you run ttree.
415 # This file is always processed before any file specified by '-f'. If
416 # you define the 'src' and 'dest' options then these will be used by
417 # default. Values for these options defined in files loaded with '-f'
418 # will override these default. Other options such as 'lib', 'ignore',
419 # 'copy' and 'accept' are accumulative.
420
421 # The 'src' option defines the location of the template files that
422 # you want to process
423 src = ~/websrc/public_html
424
425 # The 'dest' option specifies where the output should go. The script
426 # compares the modification dates of files in the 'src' and 'dest'
427 # directories to work out which need to be processed.
428 dest = ~/public_html
429
430 # 'lib' tells the processor (via INCLUDE_PATH) where to find any
431 # template files that may be INCLUDE'd. You can specify many.
432 lib = ~/websrc/templates
433 lib = /usr/local/templates/lib
434
435 # Things that aren't templates and should be ignored, specified as Perl
436 # regexen.
437 ignore = \\b(CVS|RCS)\\b
438 ignore = ^#
439
440 # Things that should be copied rather than processed.
441 copy = \\.png\$
442 copy = \\.gif\$
443
444 # By default, everything not ignored or copied is accepted; add 'accept'
445 # lines if you want to filter further. e.g.
446 # accept = \\.html\$
447 # accept = \\.atml\$
448
449 END_OF_CONFIG
450
451 close(CONFIG);
452 print "$file created. Please edit accordingly and re-run $NAME\n";
453 }
454
455
456 #------------------------------------------------------------------------
457 # help()
458 #
459 # Prints help message and exits.
460 #------------------------------------------------------------------------
461
462 sub help {
463 print<<END_OF_HELP;
464 $NAME $VERSION (Template Toolkit version $Template::VERSION)
465
466 usage: $NAME [options] [files]
467
468 Options:
469 -a (--all) Process all files, regardless of modification
470 -r (--recurse) Recurse into sub-directories
471 -p (--preserve) Preserve file ownership and permission
472 -n (--nothing) Do nothing, just print summary (enables -v)
473 -v (--verbose) Verbose mode
474 -d (--debug) Debug mode
475 -h (--help) This help
476 -s DIR (--src=DIR) Source directory
477 -d DIR (--dest=DIR) Destination directory
478 -c DIR (--cfg=DIR) Location of configuration files
479 -l DIR (--lib=DIR) Library directory (INCLUDE_PATH) (multiple)
480 -f FILE (--file=FILE) Read named configuration file (multiple)
481
482 File search specifications (all may appear multiple times):
483 --ignore=REGEX Ignore files matching REGEX
484 --copy=REGEX Copy files matching REGEX
485 --accept=REGEX Process only files matching REGEX
486
487 Additional options to set Template Toolkit configuration items:
e1ad160 @abw *** empty log message ***
authored
488 --define var=value Define template variable
3ebfa07 @abw Initial revision
authored
489 --interpolate Interpolate '\$var' references in text
d52480d @abw *** empty log message ***
authored
490 --anycase Accept directive keywords in any case.
3ebfa07 @abw Initial revision
authored
491 --pre_chomp Chomp leading whitespace
492 --post_chomp Chomp trailing whitespace
49d1e32 @abw *** empty log message ***
authored
493 --trim Trim blank lines around template blocks
d52480d @abw *** empty log message ***
authored
494 --eval_perl Evaluate [% PERL %] ... [% END %] code blocks
495 --load_perl Load regular Perl modules via USE directive
496 --pre_process=TEMPLATE Add TEMPLATE as header for each file
497 --post_process=TEMPLATE Add TEMPLATE as footer for each file
498 --process=TEMPLATE Use TEMPLATE as wrapper around each file
499 --default=TEMPLATE Use TEMPLATE as default
500 --error=TEMPLATE Use TEMPLATE to handle errors
3ebfa07 @abw Initial revision
authored
501 --start_tag=STRING STRING defines start of directive tag
502 --end_tag=STRING STRING defined end of directive tag
503 --tag_style=STYLE Use pre-defined tag STYLE
504 --plugin_base=PACKAGE Base PACKAGE for plugins
d52480d @abw *** empty log message ***
authored
505 --compile_ext=STRING File extension for compiled template files
506 --compile_dir=DIR Directory for compiled template files
3ebfa07 @abw Initial revision
authored
507 --perl5lib=DIR Specify additional Perl library directories
508
509 See 'perldoc ttree' for further information. Note that earlier versions
510 of AppConfig (<1.53) may require options of the form '--name=opt' to be
511 specified as '-name opt'.
512
513 END_OF_HELP
514
515 exit(0);
516 }
517
d52480d @abw *** empty log message ***
authored
518
519
3ebfa07 @abw Initial revision
authored
520 __END__
521
522 #------------------------------------------------------------------------
523 # POD
524 #
525
526 =head1 NAME
527
528 ttree - template tree processor
529
530 =head1 SYNOPSIS
531
532 ttree [options] [files]
533
534 =head1 DESCRIPTION
535
536 The F<ttree> script is used to process entire directory trees containing
537 template files. The resulting output from processing each file is then
538 written to a corresponding file in a destination directory. The script
539 compares the modification times of source and destination files (where
540 they already exist) and processes only those files that have been modified.
541 In other words, it is the equivalent of 'make' for the Template Toolkit.
542
543 It supports a number of options which can be used to configure
544 behaviour, define locations and set Template Toolkit options. The
545 script first reads the F<.ttreerc> configuration file in the HOME
546 directory, or an alternative file specified in the TTREERC environment
547 variable. Then, it processes any command line arguments, including
548 any additional configuration files specified via the B<-f> (file) option.
549
550 A typical F<.ttreerc> file might look like this:
551
552 src = /home/abw/websrc/doc
553 dest = /home/abw/public_html
554 lib = /home/abw/websrc/lib
555 lib = /usr/local/templates/lib
556 cfg = /home/abw/.ttree
557 ignore = \b(CVS|RCS)\b
558 ignore = ^#
559 copy = \.(gif|png)$
560 accept = \.[ah]tml$
561
562 The B<src> option indicates a directory containing the template files
563 to be processed. A list of files may be specified on the command line
564 and each will be processed in turn, writing the generated output to a
565 corresponding file in the B<dest> directory. If no files are
566 explicitly named then all files in the B<src> directory will be
567 processed. The B<-r> (recurse) option will also cause sub-directories
568 to be searched for files. A source file is only processed if it has a
569 later modification time than any corresponding destination file.
570 Files will always be processed, regardless of modification times, if
571 they are named explicitly on the command line, or the B<-a> (all)
572 option is used.
573
574 The B<lib> option may be specified any number of times to indicate
575 directories in which the Template Toolkit should look for other
576 template files (INCLUDE_PATH) that it may need to INCLUDE or PROCESS,
577 but don't represent complete documents that should be processed in
578 their own right (e.g. headers, footers, menu). The B<cfg> directory
579 specifies the location of additional configuration files that may be
580 loaded via the B<-f> option.
581
582 The B<ignore>, B<copy> and B<accept> options are used to specify Perl
583 regexen to filter file names. Files that match any of the B<ignore>
584 options will not be processed. Remaining files that match any of the
585 B<copy> regexen will be copied to the destination directory. Remaining
586 files that then match any of the B<accept> criteria are then processed
587 via the Template Toolkit. If no B<accept> parameter is specified then
588 all files will be accepted for processing if not already copied or
589 ignored.
590
591 Additional options may be used to set Template Toolkit parameters.
592 For example:
593
594 interpolate
595 post_chomp
596 pre_process = header
597 post_process = footer
598 perl5lib = /home/abw/lib/perl5
599
600 See B<ttree --help> for a summary of options.
601
602 =head1 AUTHOR
603
82cbea8 @abw version 2.00
authored
604 Andy Wardley E<lt>abw@kfs.orgE<gt>
3ebfa07 @abw Initial revision
authored
605
606 =head1 REVISION
607
608 $Revision$
609
610 =head1 COPYRIGHT
611
82cbea8 @abw version 2.00
authored
612 Copyright (C) 1996-2000 Andy Wardley. All Rights Reserved.
613 Copyright (C) 1998-2000 Canon Research Centre Europe Ltd.
3ebfa07 @abw Initial revision
authored
614
615 This module is free software; you can redistribute it and/or
616 modify it under the same terms as Perl itself.
617
618 =head1 SEE ALSO
619
620 L<Template|Template>
621
622 =cut
623
624
625
Something went wrong with that request. Please try again.