home *** CD-ROM | disk | FTP | other *** search
/ PC Professionell 2004 December / PCpro_2004_12.ISO / files / webserver / tsw / TSW_3.4.0.exe / Apache2 / perl / Provider.pm < prev    next >
Encoding:
Perl POD Document  |  2004-01-30  |  45.8 KB  |  1,450 lines

  1. #============================================================= -*-Perl-*-
  2. #
  3. # Template::Provider
  4. #
  5. # DESCRIPTION
  6. #   This module implements a class which handles the loading, compiling
  7. #   and caching of templates.  Multiple Template::Provider objects can
  8. #   be stacked and queried in turn to effect a Chain-of-Command between 
  9. #   them.  A provider will attempt to return the requested template,
  10. #   an error (STATUS_ERROR) or decline to provide the template 
  11. #   (STATUS_DECLINE), allowing subsequent providers to attempt to 
  12. #   deliver it.   See 'Design Patterns' for further details.
  13. #
  14. # AUTHOR
  15. #   Andy Wardley   <abw@wardley.org>
  16. #
  17. # COPYRIGHT
  18. #   Copyright (C) 1996-2003 Andy Wardley.  All Rights Reserved.
  19. #   Copyright (C) 1998-2000 Canon Research Centre Europe Ltd.
  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. # TODO:
  25. #   * optional provider prefix (e.g. 'http:')
  26. #   * fold ABSOLUTE and RELATIVE test cases into one regex?
  27. #
  28. #----------------------------------------------------------------------------
  29. #
  30. # $Id: Provider.pm,v 2.79 2004/01/13 16:19:16 abw Exp $
  31. #
  32. #============================================================================
  33.  
  34. package Template::Provider;
  35.  
  36. require 5.004;
  37.  
  38. use strict;
  39. use vars qw( $VERSION $DEBUG $ERROR $DOCUMENT $STAT_TTL $MAX_DIRS );
  40. use base qw( Template::Base );
  41. use Template::Config;
  42. use Template::Constants;
  43. use Template::Document;
  44. use File::Basename;
  45. use File::Spec;
  46.  
  47. $VERSION  = sprintf("%d.%02d", q$Revision: 2.79 $ =~ /(\d+)\.(\d+)/);
  48.  
  49. # name of document class
  50. $DOCUMENT = 'Template::Document' unless defined $DOCUMENT;
  51.  
  52. # maximum time between performing stat() on file to check staleness
  53. $STAT_TTL = 1 unless defined $STAT_TTL;
  54.  
  55. # maximum number of directories in an INCLUDE_PATH, to prevent runaways
  56. $MAX_DIRS = 64 unless defined $MAX_DIRS;
  57.  
  58. use constant PREV   => 0;
  59. use constant NAME   => 1;
  60. use constant DATA   => 2; 
  61. use constant LOAD   => 3;
  62. use constant NEXT   => 4;
  63. use constant STAT   => 5;
  64.  
  65. $DEBUG = 0 unless defined $DEBUG;
  66.  
  67. #========================================================================
  68. #                         -- PUBLIC METHODS --
  69. #========================================================================
  70.  
  71. #------------------------------------------------------------------------
  72. # fetch($name)
  73. #
  74. # Returns a compiled template for the name specified by parameter.
  75. # The template is returned from the internal cache if it exists, or
  76. # loaded and then subsequently cached.  The ABSOLUTE and RELATIVE
  77. # configuration flags determine if absolute (e.g. '/something...')
  78. # and/or relative (e.g. './something') paths should be honoured.  The
  79. # INCLUDE_PATH is otherwise used to find the named file. $name may
  80. # also be a reference to a text string containing the template text,
  81. # or a file handle from which the content is read.  The compiled
  82. # template is not cached in these latter cases given that there is no
  83. # filename to cache under.  A subsequent call to store($name,
  84. # $compiled) can be made to cache the compiled template for future
  85. # fetch() calls, if necessary. 
  86. #
  87. # Returns a compiled template or (undef, STATUS_DECLINED) if the 
  88. # template could not be found.  On error (e.g. the file was found 
  89. # but couldn't be read or parsed), the pair ($error, STATUS_ERROR)
  90. # is returned.  The TOLERANT configuration option can be set to 
  91. # downgrade any errors to STATUS_DECLINE.
  92. #------------------------------------------------------------------------
  93.  
  94. sub fetch {
  95.     my ($self, $name) = @_;
  96.     my ($data, $error);
  97.  
  98.     if (ref $name) {
  99.         # $name can be a reference to a scalar, GLOB or file handle
  100.         ($data, $error) = $self->_load($name);
  101.         ($data, $error) = $self->_compile($data)
  102.             unless $error;
  103.         $data = $data->{ data }
  104.         unless $error;
  105.     }
  106.     elsif (File::Spec->file_name_is_absolute($name)) {
  107.         # absolute paths (starting '/') allowed if ABSOLUTE set
  108.         ($data, $error) = $self->{ ABSOLUTE } 
  109.         ? $self->_fetch($name) 
  110.             : $self->{ TOLERANT } 
  111.         ? (undef, Template::Constants::STATUS_DECLINED)
  112.             : ("$name: absolute paths are not allowed (set ABSOLUTE option)",
  113.                Template::Constants::STATUS_ERROR);
  114.     }
  115.     elsif ($name =~ m[^\.+/]) {
  116.         # anything starting "./" is relative to cwd, allowed if RELATIVE set
  117.         ($data, $error) = $self->{ RELATIVE } 
  118.         ? $self->_fetch($name) 
  119.             : $self->{ TOLERANT } 
  120.         ? (undef, Template::Constants::STATUS_DECLINED)
  121.             : ("$name: relative paths are not allowed (set RELATIVE option)",
  122.                Template::Constants::STATUS_ERROR);
  123.     }
  124.     else {
  125.         # otherwise, it's a file name relative to INCLUDE_PATH
  126.         ($data, $error) = $self->{ INCLUDE_PATH } 
  127.         ? $self->_fetch_path($name) 
  128.             : (undef, Template::Constants::STATUS_DECLINED);
  129.     }
  130.     
  131. #    $self->_dump_cache() 
  132. #    if $DEBUG > 1;
  133.  
  134.     return ($data, $error);
  135. }
  136.  
  137.  
  138. #------------------------------------------------------------------------
  139. # store($name, $data)
  140. #
  141. # Store a compiled template ($data) in the cached as $name.
  142. #------------------------------------------------------------------------
  143.  
  144. sub store {
  145.     my ($self, $name, $data) = @_;
  146.     $self->_store($name, {
  147.         data => $data,
  148.         load => 0,
  149.     });
  150. }
  151.  
  152.  
  153. #------------------------------------------------------------------------
  154. # load($name)
  155. #
  156. # Load a template without parsing/compiling it, suitable for use with 
  157. # the INSERT directive.  There's some duplication with fetch() and at
  158. # some point this could be reworked to integrate them a little closer.
  159. #------------------------------------------------------------------------
  160.  
  161. sub load {
  162.     my ($self, $name) = @_;
  163.     my ($data, $error);
  164.     my $path = $name;
  165.  
  166.     if (File::Spec->file_name_is_absolute($name)) {
  167.         # absolute paths (starting '/') allowed if ABSOLUTE set
  168.         $error = "$name: absolute paths are not allowed (set ABSOLUTE option)" 
  169.             unless $self->{ ABSOLUTE };
  170.     }
  171.     elsif ($name =~ m[^\.+/]) {
  172.         # anything starting "./" is relative to cwd, allowed if RELATIVE set
  173.         $error = "$name: relative paths are not allowed (set RELATIVE option)"
  174.             unless $self->{ RELATIVE };
  175.     }
  176.     else {
  177.       INCPATH: {
  178.           # otherwise, it's a file name relative to INCLUDE_PATH
  179.           my $paths = $self->paths()
  180.               || return ($self->error(), Template::Constants::STATUS_ERROR);
  181.  
  182.           foreach my $dir (@$paths) {
  183.               $path = "$dir/$name";
  184.               last INCPATH
  185.                   if -f $path;
  186.           }
  187.           undef $path;        # not found
  188.       }
  189.     }
  190.  
  191.     if (defined $path && ! $error) {
  192.         local $/ = undef;    # slurp files in one go
  193.         local *FH;
  194.         if (open(FH, $path)) {
  195.             $data = <FH>;
  196.             close(FH);
  197.         }
  198.         else {
  199.             $error = "$name: $!";
  200.         }
  201.     }
  202.     
  203.     if ($error) {
  204.         return $self->{ TOLERANT } 
  205.             ? (undef, Template::Constants::STATUS_DECLINED)
  206.             : ($error, Template::Constants::STATUS_ERROR);
  207.     }
  208.     elsif (! defined $path) {
  209.         return (undef, Template::Constants::STATUS_DECLINED);
  210.     }
  211.     else {
  212.         return ($data, Template::Constants::STATUS_OK);
  213.     }
  214. }
  215.  
  216.  
  217.  
  218. #------------------------------------------------------------------------
  219. # include_path(\@newpath)
  220. #
  221. # Accessor method for the INCLUDE_PATH setting.  If called with an
  222. # argument, this method will replace the existing INCLUDE_PATH with
  223. # the new value.
  224. #------------------------------------------------------------------------
  225.  
  226. sub include_path {
  227.      my ($self, $path) = @_;
  228.      $self->{ INCLUDE_PATH } = $path if $path;
  229.      return $self->{ INCLUDE_PATH };
  230. }
  231.  
  232.  
  233. #------------------------------------------------------------------------
  234. # paths()
  235. #
  236. # Evaluates the INCLUDE_PATH list, ignoring any blank entries, and 
  237. # calling and subroutine or object references to return dynamically
  238. # generated path lists.  Returns a reference to a new list of paths 
  239. # or undef on error.
  240. #------------------------------------------------------------------------
  241.  
  242. sub paths {
  243.     my $self   = shift;
  244.     my @ipaths = @{ $self->{ INCLUDE_PATH } };
  245.     my (@opaths, $dpaths, $dir);
  246.     my $count = $MAX_DIRS;
  247.     
  248.     while (@ipaths && --$count) {
  249.         $dir = shift @ipaths || next;
  250.         
  251.         # $dir can be a sub or object ref which returns a reference
  252.         # to a dynamically generated list of search paths.
  253.         
  254.         if (ref $dir eq 'CODE') {
  255.             eval { $dpaths = &$dir() };
  256.             if ($@) {
  257.                 chomp $@;
  258.                 return $self->error($@);
  259.             }
  260.             unshift(@ipaths, @$dpaths);
  261.             next;
  262.         }
  263.         elsif (UNIVERSAL::can($dir, 'paths')) {
  264.             $dpaths = $dir->paths() 
  265.                 || return $self->error($dir->error());
  266.             unshift(@ipaths, @$dpaths);
  267.             next;
  268.         }
  269.         else {
  270.             push(@opaths, $dir);
  271.         }
  272.     }
  273.     return $self->error("INCLUDE_PATH exceeds $MAX_DIRS directories")
  274.     if @ipaths;
  275.  
  276.     return \@opaths;
  277. }
  278.  
  279.  
  280. #------------------------------------------------------------------------
  281. # DESTROY
  282. #
  283. # The provider cache is implemented as a doubly linked list which Perl
  284. # cannot free by itself due to the circular references between NEXT <=> 
  285. # PREV items.  This cleanup method walks the list deleting all the NEXT/PREV 
  286. # references, allowing the proper cleanup to occur and memory to be 
  287. # repooled.
  288. #------------------------------------------------------------------------
  289.  
  290. sub DESTROY {
  291.     my $self = shift;
  292.     my ($slot, $next);
  293.  
  294.     $slot = $self->{ HEAD };
  295.     while ($slot) {
  296.         $next = $slot->[ NEXT ];
  297.         undef $slot->[ PREV ];
  298.         undef $slot->[ NEXT ];
  299.         $slot = $next;
  300.     }
  301.     undef $self->{ HEAD };
  302.     undef $self->{ TAIL };
  303. }
  304.  
  305.  
  306.  
  307.  
  308. #========================================================================
  309. #                        -- PRIVATE METHODS --
  310. #========================================================================
  311.  
  312. #------------------------------------------------------------------------
  313. # _init()
  314. #
  315. # Initialise the cache.
  316. #------------------------------------------------------------------------
  317.  
  318. sub _init {
  319.     my ($self, $params) = @_;
  320.     my $size = $params->{ CACHE_SIZE   };
  321.     my $path = $params->{ INCLUDE_PATH } || '.';
  322.     my $cdir = $params->{ COMPILE_DIR  } || '';
  323.     my $dlim = $params->{ DELIMITER    };
  324.     my $debug;
  325.  
  326.     # tweak delim to ignore C:/
  327.     unless (defined $dlim) {
  328.         $dlim = ($^O eq 'MSWin32') ? ':(?!\\/)' : ':';
  329.     }
  330.  
  331.     # coerce INCLUDE_PATH to an array ref, if not already so
  332.     $path = [ split(/$dlim/, $path) ]
  333.         unless ref $path eq 'ARRAY';
  334.     
  335.     # don't allow a CACHE_SIZE 1 because it breaks things and the 
  336.     # additional checking isn't worth it
  337.     $size = 2 
  338.         if defined $size && ($size == 1 || $size < 0);
  339.  
  340.     if (defined ($debug = $params->{ DEBUG })) {
  341.         $self->{ DEBUG } = $debug & ( Template::Constants::DEBUG_PROVIDER
  342.                                     | Template::Constants::DEBUG_FLAGS );
  343.     }
  344.     else {
  345.         $self->{ DEBUG } = $DEBUG;
  346.     }
  347.  
  348.     if ($self->{ DEBUG }) {
  349.         local $" = ', ';
  350.         $self->debug("creating cache of ", 
  351.                      defined $size ? $size : 'unlimited',
  352.                      " slots for [ @$path ]");
  353.     }
  354.     
  355.     # create COMPILE_DIR and sub-directories representing each INCLUDE_PATH
  356.     # element in which to store compiled files
  357.     if ($cdir) {
  358.         
  359. # Stas' hack
  360. #        # this is a hack to solve the problem with INCLUDE_PATH using
  361. #     # relative dirs
  362. #     my $segments = 0;
  363. #     for (@$path) {
  364. #         my $c = 0;
  365. #         $c++ while m|\.\.|g;
  366. #         $segments = $c if $c > $segments;
  367. #     }
  368. #     $cdir .= "/".join "/",('hack') x $segments if $segments;
  369. #
  370.  
  371.         require File::Path;
  372.         foreach my $dir (@$path) {
  373.             next if ref $dir;
  374.             my $wdir = $dir;
  375.             $wdir =~ s[:][]g if $^O eq 'MSWin32';
  376.             $wdir =~ /(.*)/;  # untaint
  377.             &File::Path::mkpath(File::Spec->catfile($cdir, $1));
  378.         }
  379.     }
  380.  
  381.     $self->{ LOOKUP       } = { };
  382.     $self->{ SLOTS        } = 0;
  383.     $self->{ SIZE         } = $size;
  384.     $self->{ INCLUDE_PATH } = $path;
  385.     $self->{ DELIMITER    } = $dlim;
  386.     $self->{ COMPILE_DIR  } = $cdir;
  387.     $self->{ COMPILE_EXT  } = $params->{ COMPILE_EXT } || '';
  388.     $self->{ ABSOLUTE     } = $params->{ ABSOLUTE } || 0;
  389.     $self->{ RELATIVE     } = $params->{ RELATIVE } || 0;
  390.     $self->{ TOLERANT     } = $params->{ TOLERANT } || 0;
  391.     $self->{ DOCUMENT     } = $params->{ DOCUMENT } || $DOCUMENT;
  392.     $self->{ PARSER       } = $params->{ PARSER };
  393.     $self->{ DEFAULT      } = $params->{ DEFAULT };
  394. #   $self->{ PREFIX       } = $params->{ PREFIX };
  395.     $self->{ PARAMS       } = $params;
  396.  
  397.     return $self;
  398. }
  399.  
  400.  
  401. #------------------------------------------------------------------------
  402. # _fetch($name)
  403. #
  404. # Fetch a file from cache or disk by specification of an absolute or
  405. # relative filename.  No search of the INCLUDE_PATH is made.  If the 
  406. # file is found and loaded, it is compiled and cached.
  407. #------------------------------------------------------------------------
  408.  
  409. sub _fetch {
  410.     my ($self, $name) = @_;
  411.     my $size = $self->{ SIZE };
  412.     my ($slot, $data, $error);
  413.  
  414.     $self->debug("_fetch($name)") if $self->{ DEBUG };
  415.  
  416.     my $compiled = $self->_compiled_filename($name);
  417.  
  418.     if (defined $size && ! $size) {
  419.         # caching disabled so load and compile but don't cache
  420.         if ($compiled && -f $compiled 
  421.             && (stat($name))[9] <= (stat($compiled))[9]) {
  422.             $data = $self->_load_compiled($compiled);
  423.             $error = $self->error() unless $data;
  424.         }
  425.         else {
  426.             ($data, $error) = $self->_load($name);
  427.             ($data, $error) = $self->_compile($data, $compiled)
  428.                 unless $error;
  429.             $data = $data->{ data }
  430.             unless $error;
  431.         }
  432.     }
  433.     elsif ($slot = $self->{ LOOKUP }->{ $name }) {
  434.         # cached entry exists, so refresh slot and extract data
  435.         ($data, $error) = $self->_refresh($slot);
  436.         $data = $slot->[ DATA ]
  437.             unless $error;
  438.     }
  439.     else {
  440.         # nothing in cache so try to load, compile and cache
  441.         if ($compiled && -f $compiled 
  442.             && (stat($name))[9] <= (stat($compiled))[9]) {
  443.             $data = $self->_load_compiled($compiled);
  444.             $error = $self->error() unless $data;
  445.             $self->store($name, $data) unless $error;
  446.         }
  447.         else {
  448.             ($data, $error) = $self->_load($name);
  449.             ($data, $error) = $self->_compile($data, $compiled)
  450.                 unless $error;
  451.             $data = $self->_store($name, $data)
  452.                 unless $error;
  453.         }
  454.     }
  455.     
  456.     return ($data, $error);
  457. }
  458.  
  459.  
  460. #------------------------------------------------------------------------
  461. # _fetch_path($name)
  462. #
  463. # Fetch a file from cache or disk by specification of an absolute cache
  464. # name (e.g. 'header') or filename relative to one of the INCLUDE_PATH 
  465. # directories.  If the file isn't already cached and can be found and 
  466. # loaded, it is compiled and cached under the full filename.
  467. #------------------------------------------------------------------------
  468.  
  469. sub _fetch_path {
  470.     my ($self, $name) = @_;
  471.     my ($size, $compext, $compdir) = 
  472.     @$self{ qw( SIZE COMPILE_EXT COMPILE_DIR ) };
  473.     my ($dir, $paths, $path, $compiled, $slot, $data, $error);
  474.     local *FH;
  475.  
  476.     $self->debug("_fetch_path($name)") if $self->{ DEBUG };
  477.  
  478.     # caching is enabled if $size is defined and non-zero or undefined
  479.     my $caching = (! defined $size || $size);
  480.  
  481.     INCLUDE: {
  482.  
  483.         # the template may have been stored using a non-filename name
  484.         if ($caching && ($slot = $self->{ LOOKUP }->{ $name })) {
  485.             # cached entry exists, so refresh slot and extract data
  486.             ($data, $error) = $self->_refresh($slot);
  487.             $data = $slot->[ DATA ] 
  488.                 unless $error;
  489.             last INCLUDE;
  490.         }
  491.         
  492.         $paths = $self->paths() || do {
  493.             $error = Template::Constants::STATUS_ERROR;
  494.             $data  = $self->error();
  495.             last INCLUDE;
  496.         };
  497.         
  498.         # search the INCLUDE_PATH for the file, in cache or on disk
  499.         foreach $dir (@$paths) {
  500.             $path = File::Spec->catfile($dir, $name);
  501.             
  502.             $self->debug("searching path: $path\n") if $self->{ DEBUG };
  503.             
  504.             if ($caching && ($slot = $self->{ LOOKUP }->{ $path })) {
  505.                 # cached entry exists, so refresh slot and extract data
  506.                 ($data, $error) = $self->_refresh($slot);
  507.                 $data = $slot->[ DATA ]
  508.                     unless $error;
  509.                 last INCLUDE;
  510.             }
  511.             elsif (-f $path) {
  512.                 $compiled = $self->_compiled_filename($path)
  513.                     if $compext || $compdir;
  514.                 
  515.                 if ($compiled && -f $compiled 
  516.                     && (stat($path))[9] <= (stat($compiled))[9]) {
  517.                     if ($data = $self->_load_compiled($compiled)) {
  518.                         # store in cache
  519.                         $data  = $self->store($path, $data);
  520.                         $error = Template::Constants::STATUS_OK;
  521.                         last INCLUDE;
  522.                     }
  523.                     else {
  524.                         warn($self->error(), "\n");
  525.                     }
  526.                 }
  527.                 # $compiled is set if an attempt to write the compiled 
  528.                 # template to disk should be made
  529.                 
  530.                 ($data, $error) = $self->_load($path, $name);
  531.                 ($data, $error) = $self->_compile($data, $compiled)
  532.                     unless $error;
  533.                 $data = $self->_store($path, $data)
  534.                     unless $error || ! $caching;
  535.                 $data = $data->{ data } if ! $caching;
  536.                 # all done if $error is OK or ERROR
  537.                 last INCLUDE if ! $error 
  538.                     || $error == Template::Constants::STATUS_ERROR;
  539.             }
  540.         }
  541.         # template not found, so look for a DEFAULT template
  542.         my $default;
  543.         if (defined ($default = $self->{ DEFAULT }) && $name ne $default) {
  544.             $name = $default;
  545.             redo INCLUDE;
  546.         }
  547.         ($data, $error) = (undef, Template::Constants::STATUS_DECLINED);
  548.     } # INCLUDE
  549.     
  550.     return ($data, $error);
  551. }
  552.  
  553.  
  554.  
  555. sub _compiled_filename {
  556.     my ($self, $file) = @_;
  557.     my ($compext, $compdir) = @$self{ qw( COMPILE_EXT COMPILE_DIR ) };
  558.     my ($path, $compiled);
  559.  
  560.     return undef
  561.     unless $compext || $compdir;
  562.  
  563.     $path = $file;
  564.     $path =~ /^(.+)$/s or die "invalid filename: $path";
  565.     $path =~ s[:][]g if $^O eq 'MSWin32';
  566.  
  567.     $compiled = "$path$compext";
  568.     $compiled = File::Spec->catfile($compdir, $compiled) if length $compdir;
  569.  
  570.     return $compiled;
  571. }
  572.  
  573.  
  574. sub _load_compiled {
  575.     my ($self, $file) = @_;
  576.     my $compiled;
  577.  
  578.     # load compiled template via require();  we zap any
  579.     # %INC entry to ensure it is reloaded (we don't 
  580.     # want 1 returned by require() to say it's in memory)
  581.     delete $INC{ $file };
  582.     eval { $compiled = require $file; };
  583.     return $@
  584.         ? $self->error("compiled template $compiled: $@")
  585.         : $compiled;
  586. }
  587.  
  588.  
  589.  
  590. #------------------------------------------------------------------------
  591. # _load($name, $alias)
  592. #
  593. # Load template text from a string ($name = scalar ref), GLOB or file 
  594. # handle ($name = ref), or from an absolute filename ($name = scalar).
  595. # Returns a hash array containing the following items:
  596. #   name    filename or $alias, if provided, or 'input text', etc.
  597. #   text    template text
  598. #   time    modification time of file, or current time for handles/strings
  599. #   load    time file was loaded (now!)  
  600. #
  601. # On error, returns ($error, STATUS_ERROR), or (undef, STATUS_DECLINED)
  602. # if TOLERANT is set.
  603. #------------------------------------------------------------------------
  604.  
  605. sub _load {
  606.     my ($self, $name, $alias) = @_;
  607.     my ($data, $error);
  608.     my $tolerant = $self->{ TOLERANT };
  609.     my $now = time;
  610.     local $/ = undef;    # slurp files in one go
  611.     local *FH;
  612.  
  613.     $alias = $name unless defined $alias or ref $name;
  614.  
  615.     $self->debug("_load($name, ", defined $alias ? $alias : '<no alias>', 
  616.                  ')') if $self->{ DEBUG };
  617.  
  618.     LOAD: {
  619.         if (ref $name eq 'SCALAR') {
  620.             # $name can be a SCALAR reference to the input text...
  621.             $data = {
  622.                 name => defined $alias ? $alias : 'input text',
  623.                 text => $$name,
  624.                 time => $now,
  625.                 load => 0,
  626.             };
  627.         }
  628.         elsif (ref $name) {
  629.             # ...or a GLOB or file handle...
  630.             my $text = <$name>;
  631.             $data = {
  632.                 name => defined $alias ? $alias : 'input file handle',
  633.                 text => $text,
  634.                 time => $now,
  635.                 load => 0,
  636.             };
  637.         }
  638.         elsif (-f $name) {
  639.             if (open(FH, $name)) {
  640.                 my $text = <FH>;
  641.                 $data = {
  642.                     name => $alias,
  643.                     path => $name,
  644.                     text => $text,
  645.                     time => (stat $name)[9],
  646.                     load => $now,
  647.                 };
  648.             }
  649.             elsif ($tolerant) {
  650.                 ($data, $error) = (undef, Template::Constants::STATUS_DECLINED);
  651.             }
  652.             else {
  653.                 $data  = "$alias: $!";
  654.                 $error = Template::Constants::STATUS_ERROR;
  655.             }
  656.         }
  657.         else {
  658.             ($data, $error) = (undef, Template::Constants::STATUS_DECLINED);
  659.         }
  660.     }
  661.     
  662.     $data->{ path } = $data->{ name }
  663.         if $data and ! defined $data->{ path };
  664.     
  665.     return ($data, $error);
  666. }
  667.  
  668.  
  669. #------------------------------------------------------------------------
  670. # _refresh(\@slot)
  671. #
  672. # Private method called to mark a cache slot as most recently used.
  673. # A reference to the slot array should be passed by parameter.  The 
  674. # slot is relocated to the head of the linked list.  If the file from
  675. # which the data was loaded has been upated since it was compiled, then
  676. # it is re-loaded from disk and re-compiled.
  677. #------------------------------------------------------------------------
  678.  
  679. sub _refresh {
  680.     my ($self, $slot) = @_;
  681.     my ($head, $file, $data, $error);
  682.  
  683.  
  684.     $self->debug("_refresh([ ", 
  685.                  join(', ', map { defined $_ ? $_ : '<undef>' } @$slot),
  686.                  '])') if $self->{ DEBUG };
  687.  
  688.     # if it's more than $STAT_TTL seconds since we last performed a 
  689.     # stat() on the file then we need to do it again and see if the file
  690.     # time has changed
  691.     if ( (time - $slot->[ STAT ]) > $STAT_TTL && stat $slot->[ NAME ] ) {
  692.         $slot->[ STAT ] = time;
  693.  
  694.         if ( (stat(_))[9] != $slot->[ LOAD ]) {
  695.             
  696.             $self->debug("refreshing cache file ", $slot->[ NAME ]) 
  697.                 if $self->{ DEBUG };
  698.             
  699.             ($data, $error) = $self->_load($slot->[ NAME ],
  700.                                            $slot->[ DATA ]->{ name });
  701.             ($data, $error) = $self->_compile($data)
  702.                 unless $error;
  703.             
  704.             unless ($error) {
  705.                 $slot->[ DATA ] = $data->{ data };
  706.                 $slot->[ LOAD ] = $data->{ time };
  707.             }
  708.         }
  709.     }
  710.     
  711.     unless( $self->{ HEAD } == $slot ) {
  712.         # remove existing slot from usage chain...
  713.         if ($slot->[ PREV ]) {
  714.             $slot->[ PREV ]->[ NEXT ] = $slot->[ NEXT ];
  715.         }
  716.         else {
  717.             $self->{ HEAD } = $slot->[ NEXT ];
  718.         }
  719.         if ($slot->[ NEXT ]) {
  720.             $slot->[ NEXT ]->[ PREV ] = $slot->[ PREV ];
  721.         }
  722.         else {
  723.             $self->{ TAIL } = $slot->[ PREV ];
  724.         }
  725.         
  726.         # ..and add to start of list
  727.         $head = $self->{ HEAD };
  728.         $head->[ PREV ] = $slot if $head;
  729.         $slot->[ PREV ] = undef;
  730.         $slot->[ NEXT ] = $head;
  731.         $self->{ HEAD } = $slot;
  732.     }
  733.     
  734.     return ($data, $error);
  735. }
  736.  
  737.  
  738. #------------------------------------------------------------------------
  739. # _store($name, $data)
  740. #
  741. # Private method called to add a data item to the cache.  If the cache
  742. # size limit has been reached then the oldest entry at the tail of the 
  743. # list is removed and its slot relocated to the head of the list and 
  744. # reused for the new data item.  If the cache is under the size limit,
  745. # or if no size limit is defined, then the item is added to the head 
  746. # of the list.  
  747. #------------------------------------------------------------------------
  748.  
  749. sub _store {
  750.     my ($self, $name, $data, $compfile) = @_;
  751.     my $size = $self->{ SIZE };
  752.     my ($slot, $head);
  753.  
  754.     # extract the load time and compiled template from the data
  755. #    my $load = $data->{ load };
  756.     my $load = (stat($name))[9];
  757.     $data = $data->{ data };
  758.  
  759.     $self->debug("_store($name, $data)") if $self->{ DEBUG };
  760.  
  761.     if (defined $size && $self->{ SLOTS } >= $size) {
  762.         # cache has reached size limit, so reuse oldest entry
  763.         
  764.         $self->debug("reusing oldest cache entry (size limit reached: $size)\nslots: $self->{ SLOTS }") if $self->{ DEBUG };
  765.         
  766.         # remove entry from tail of list
  767.         $slot = $self->{ TAIL };
  768.         $slot->[ PREV ]->[ NEXT ] = undef;
  769.         $self->{ TAIL } = $slot->[ PREV ];
  770.         
  771.         # remove name lookup for old node
  772.         delete $self->{ LOOKUP }->{ $slot->[ NAME ] };
  773.         
  774.         # add modified node to head of list
  775.         $head = $self->{ HEAD };
  776.         $head->[ PREV ] = $slot if $head;
  777.         @$slot = ( undef, $name, $data, $load, $head, time );
  778.         $self->{ HEAD } = $slot;
  779.         
  780.         # add name lookup for new node
  781.         $self->{ LOOKUP }->{ $name } = $slot;
  782.     }
  783.     else {
  784.         # cache is under size limit, or none is defined
  785.         
  786.         $self->debug("adding new cache entry") if $self->{ DEBUG };
  787.         
  788.         # add new node to head of list
  789.         $head = $self->{ HEAD };
  790.         $slot = [ undef, $name, $data, $load, $head, time ];
  791.         $head->[ PREV ] = $slot if $head;
  792.         $self->{ HEAD } = $slot;
  793.         $self->{ TAIL } = $slot unless $self->{ TAIL };
  794.         
  795.         # add lookup from name to slot and increment nslots
  796.         $self->{ LOOKUP }->{ $name } = $slot;
  797.         $self->{ SLOTS }++;
  798.     }
  799.  
  800.     return $data;
  801. }
  802.  
  803.  
  804. #------------------------------------------------------------------------
  805. # _compile($data)
  806. #
  807. # Private method called to parse the template text and compile it into 
  808. # a runtime form.  Creates and delegates a Template::Parser object to
  809. # handle the compilation, or uses a reference passed in PARSER.  On 
  810. # success, the compiled template is stored in the 'data' item of the 
  811. # $data hash and returned.  On error, ($error, STATUS_ERROR) is returned,
  812. # or (undef, STATUS_DECLINED) if the TOLERANT flag is set.
  813. # The optional $compiled parameter may be passed to specify
  814. # the name of a compiled template file to which the generated Perl
  815. # code should be written.  Errors are (for now...) silently 
  816. # ignored, assuming that failures to open a file for writing are 
  817. # intentional (e.g directory write permission).
  818. #------------------------------------------------------------------------
  819.  
  820. sub _compile {
  821.     my ($self, $data, $compfile) = @_;
  822.     my $text = $data->{ text };
  823.     my ($parsedoc, $error);
  824.  
  825.     $self->debug("_compile($data, ", 
  826.                  defined $compfile ? $compfile : '<no compfile>', ')') 
  827.         if $self->{ DEBUG };
  828.  
  829.     my $parser = $self->{ PARSER } 
  830.         ||= Template::Config->parser($self->{ PARAMS })
  831.         ||  return (Template::Config->error(), Template::Constants::STATUS_ERROR);
  832.  
  833.     # discard the template text - we don't need it any more
  834.     delete $data->{ text };   
  835.     
  836.     # call parser to compile template into Perl code
  837.     if ($parsedoc = $parser->parse($text, $data)) {
  838.  
  839.         $parsedoc->{ METADATA } = { 
  840.             'name'    => $data->{ name },
  841.             'modtime' => $data->{ time },
  842.             %{ $parsedoc->{ METADATA } },
  843.         };
  844.         
  845.         # write the Perl code to the file $compfile, if defined
  846.         if ($compfile) {
  847.             my $basedir = &File::Basename::dirname($compfile);
  848.             $basedir =~ /(.*)/;
  849.             $basedir = $1;
  850.             &File::Path::mkpath($basedir) unless -d $basedir;
  851.             
  852.             my $docclass = $self->{ DOCUMENT };
  853.             $error = 'cache failed to write '
  854.                 . &File::Basename::basename($compfile)
  855.                 . ': ' . $docclass->error()
  856.                 unless $docclass->write_perl_file($compfile, $parsedoc);
  857.             
  858.             # set atime and mtime of newly compiled file, don't bother
  859.             # if time is undef
  860.             if (!defined($error) && defined $data->{ time }) {
  861.                 my ($cfile) = $compfile =~ /^(.+)$/s or do {
  862.                     return("invalid filename: $compfile", 
  863.                            Template::Constants::STATUS_ERROR);
  864.                 };
  865.                 
  866.                 my ($ctime) = $data->{ time } =~ /^(\d+)$/;
  867.                 unless ($ctime || $ctime eq 0) {
  868.                     return("invalid time: $ctime", 
  869.                            Template::Constants::STATUS_ERROR);
  870.                 }
  871.                 utime($ctime, $ctime, $cfile);
  872.             }
  873.         }
  874.         
  875.         unless ($error) {
  876.             return $data                        ## RETURN ##
  877.                 if $data->{ data } = $DOCUMENT->new($parsedoc);
  878.             $error = $Template::Document::ERROR;
  879.         }
  880.     }
  881.     else {
  882.         $error = Template::Exception->new( 'parse', "$data->{ name } " .
  883.                                            $parser->error() );
  884.     }
  885.     
  886.     # return STATUS_ERROR, or STATUS_DECLINED if we're being tolerant
  887.     return $self->{ TOLERANT } 
  888.         ? (undef, Template::Constants::STATUS_DECLINED)
  889.         : ($error,  Template::Constants::STATUS_ERROR)
  890. }
  891.  
  892.  
  893. #------------------------------------------------------------------------
  894. # _dump()
  895. #
  896. # Debug method which returns a string representing the internal object 
  897. # state.
  898. #------------------------------------------------------------------------
  899.  
  900. sub _dump {
  901.     my $self = shift;
  902.     my $size = $self->{ SIZE };
  903.     my $parser = $self->{ PARSER };
  904.     $parser = $parser ? $parser->_dump() : '<no parser>';
  905.     $parser =~ s/\n/\n    /gm;
  906.     $size = 'unlimited' unless defined $size;
  907.  
  908.     my $output = "[Template::Provider] {\n";
  909.     my $format = "    %-16s => %s\n";
  910.     my $key;
  911.     
  912.     $output .= sprintf($format, 'INCLUDE_PATH', 
  913.                        '[ ' . join(', ', @{ $self->{ INCLUDE_PATH } }) . ' ]');
  914.     $output .= sprintf($format, 'CACHE_SIZE', $size);
  915.     
  916.     foreach $key (qw( ABSOLUTE RELATIVE TOLERANT DELIMITER
  917.                       COMPILE_EXT COMPILE_DIR )) {
  918.         $output .= sprintf($format, $key, $self->{ $key });
  919.     }
  920.     $output .= sprintf($format, 'PARSER', $parser);
  921.  
  922.  
  923.     local $" = ', ';
  924.     my $lookup = $self->{ LOOKUP };
  925.     $lookup = join('', map { 
  926.         sprintf("    $format", $_, defined $lookup->{ $_ }
  927.                 ? ('[ ' . join(', ', map { defined $_ ? $_ : '<undef>' }
  928.                                @{ $lookup->{ $_ } }) . ' ]') : '<undef>');
  929.     } sort keys %$lookup);
  930.     $lookup = "{\n$lookup    }";
  931.     
  932.     $output .= sprintf($format, LOOKUP => $lookup);
  933.     
  934.     $output .= '}';
  935.     return $output;
  936. }
  937.  
  938.  
  939. #------------------------------------------------------------------------
  940. # _dump_cache()
  941. #
  942. # Debug method which prints the current state of the cache to STDERR.
  943. #------------------------------------------------------------------------
  944.  
  945. sub _dump_cache {
  946.     my $self = shift;
  947.     my ($node, $lut, $count);
  948.  
  949.     $count = 0;
  950.     if ($node = $self->{ HEAD }) {
  951.     while ($node) {
  952.         $lut->{ $node } = $count++;
  953.         $node = $node->[ NEXT ];
  954.     }
  955.     $node = $self->{ HEAD };
  956.     print STDERR "CACHE STATE:\n";
  957.     print STDERR "  HEAD: ", $self->{ HEAD }->[ NAME ], "\n";
  958.     print STDERR "  TAIL: ", $self->{ TAIL }->[ NAME ], "\n";
  959.     while ($node) {
  960.         my ($prev, $name, $data, $load, $next) = @$node;
  961. #        $name = '...' . substr($name, -10) if length $name > 10;
  962.         $prev = $prev ? "#$lut->{ $prev }<-": '<undef>';
  963.         $next = $next ? "->#$lut->{ $next }": '<undef>';
  964.         print STDERR "   #$lut->{ $node } : [ $prev, $name, $data, $load, $next ]\n";
  965.         $node = $node->[ NEXT ];
  966.     }
  967.     }
  968. }
  969.  
  970. 1;
  971.  
  972. __END__
  973.  
  974.  
  975. #------------------------------------------------------------------------
  976. # IMPORTANT NOTE
  977. #   This documentation is generated automatically from source
  978. #   templates.  Any changes you make here may be lost.
  979. #   The 'docsrc' documentation source bundle is available for download
  980. #   from http://www.template-toolkit.org/docs.html and contains all
  981. #   the source templates, XML files, scripts, etc., from which the
  982. #   documentation for the Template Toolkit is built.
  983. #------------------------------------------------------------------------
  984.  
  985. =head1 NAME
  986.  
  987. Template::Provider - Provider module for loading/compiling templates
  988.  
  989. =head1 SYNOPSIS
  990.  
  991.     $provider = Template::Provider->new(\%options);
  992.  
  993.     ($template, $error) = $provider->fetch($name);
  994.  
  995. =head1 DESCRIPTION
  996.  
  997. The Template::Provider is used to load, parse, compile and cache template
  998. documents.  This object may be sub-classed to provide more specific 
  999. facilities for loading, or otherwise providing access to templates.
  1000.  
  1001. The Template::Context objects maintain a list of Template::Provider 
  1002. objects which are polled in turn (via fetch()) to return a requested
  1003. template.  Each may return a compiled template, raise an error, or 
  1004. decline to serve the reqest, giving subsequent providers a chance to
  1005. do so.
  1006.  
  1007. This is the "Chain of Responsiblity" pattern.  See 'Design Patterns' for
  1008. further information.
  1009.  
  1010. This documentation needs work.
  1011.  
  1012. =head1 PUBLIC METHODS
  1013.  
  1014. =head2 new(\%options) 
  1015.  
  1016. Constructor method which instantiates and returns a new Template::Provider
  1017. object.  The optional parameter may be a hash reference containing any of
  1018. the following items:
  1019.  
  1020. =over 4
  1021.  
  1022.  
  1023.  
  1024.  
  1025. =item INCLUDE_PATH
  1026.  
  1027. The INCLUDE_PATH is used to specify one or more directories in which
  1028. template files are located.  When a template is requested that isn't
  1029. defined locally as a BLOCK, each of the INCLUDE_PATH directories is
  1030. searched in turn to locate the template file.  Multiple directories
  1031. can be specified as a reference to a list or as a single string where
  1032. each directory is delimited by ':'.
  1033.  
  1034.     my $provider = Template::Provider->new({
  1035.         INCLUDE_PATH => '/usr/local/templates',
  1036.     });
  1037.   
  1038.     my $provider = Template::Provider->new({
  1039.         INCLUDE_PATH => '/usr/local/templates:/tmp/my/templates',
  1040.     });
  1041.   
  1042.     my $provider = Template::Provider->new({
  1043.         INCLUDE_PATH => [ '/usr/local/templates', 
  1044.                           '/tmp/my/templates' ],
  1045.     });
  1046.  
  1047. On Win32 systems, a little extra magic is invoked, ignoring delimiters
  1048. that have ':' followed by a '/' or '\'.  This avoids confusion when using
  1049. directory names like 'C:\Blah Blah'.
  1050.  
  1051. When specified as a list, the INCLUDE_PATH path can contain elements 
  1052. which dynamically generate a list of INCLUDE_PATH directories.  These 
  1053. generator elements can be specified as a reference to a subroutine or 
  1054. an object which implements a paths() method.
  1055.  
  1056.     my $provider = Template::Provider->new({
  1057.         INCLUDE_PATH => [ '/usr/local/templates', 
  1058.                           \&incpath_generator, 
  1059.               My::IncPath::Generator->new( ... ) ],
  1060.     });
  1061.  
  1062. Each time a template is requested and the INCLUDE_PATH examined, the
  1063. subroutine or object method will be called.  A reference to a list of
  1064. directories should be returned.  Generator subroutines should report
  1065. errors using die().  Generator objects should return undef and make an
  1066. error available via its error() method.
  1067.  
  1068. For example:
  1069.  
  1070.     sub incpath_generator {
  1071.  
  1072.     # ...some code...
  1073.     
  1074.     if ($all_is_well) {
  1075.         return \@list_of_directories;
  1076.     }
  1077.     else {
  1078.         die "cannot generate INCLUDE_PATH...\n";
  1079.     }
  1080.     }
  1081.  
  1082. or:
  1083.  
  1084.     package My::IncPath::Generator;
  1085.  
  1086.     # Template::Base (or Class::Base) provides error() method
  1087.     use Template::Base;
  1088.     use base qw( Template::Base );
  1089.  
  1090.     sub paths {
  1091.     my $self = shift;
  1092.  
  1093.     # ...some code...
  1094.  
  1095.         if ($all_is_well) {
  1096.         return \@list_of_directories;
  1097.     }
  1098.     else {
  1099.         return $self->error("cannot generate INCLUDE_PATH...\n");
  1100.     }
  1101.     }
  1102.  
  1103.     1;
  1104.  
  1105.  
  1106.  
  1107.  
  1108.  
  1109. =item DELIMITER
  1110.  
  1111. Used to provide an alternative delimiter character sequence for 
  1112. separating paths specified in the INCLUDE_PATH.  The default
  1113. value for DELIMITER is ':'.
  1114.  
  1115.     # tolerate Silly Billy's file system conventions
  1116.     my $provider = Template::Provider->new({
  1117.     DELIMITER    => '; ',
  1118.         INCLUDE_PATH => 'C:/HERE/NOW; D:/THERE/THEN',
  1119.     });
  1120.  
  1121.     # better solution: install Linux!  :-)
  1122.  
  1123. On Win32 systems, the default delimiter is a little more intelligent,
  1124. splitting paths only on ':' characters that aren't followed by a '/'.
  1125. This means that the following should work as planned, splitting the 
  1126. INCLUDE_PATH into 2 separate directories, C:/foo and C:/bar.
  1127.  
  1128.     # on Win32 only
  1129.     my $provider = Template::Provider->new({
  1130.     INCLUDE_PATH => 'C:/Foo:C:/Bar'
  1131.     });
  1132.  
  1133. However, if you're using Win32 then it's recommended that you
  1134. explicitly set the DELIMITER character to something else (e.g. ';')
  1135. rather than rely on this subtle magic.
  1136.  
  1137.  
  1138.  
  1139.  
  1140. =item ABSOLUTE
  1141.  
  1142. The ABSOLUTE flag is used to indicate if templates specified with
  1143. absolute filenames (e.g. '/foo/bar') should be processed.  It is
  1144. disabled by default and any attempt to load a template by such a
  1145. name will cause a 'file' exception to be raised.
  1146.  
  1147.     my $provider = Template::Provider->new({
  1148.     ABSOLUTE => 1,
  1149.     });
  1150.  
  1151.     # this is why it's disabled by default
  1152.     [% INSERT /etc/passwd %]
  1153.  
  1154. On Win32 systems, the regular expression for matching absolute 
  1155. pathnames is tweaked slightly to also detect filenames that start
  1156. with a driver letter and colon, such as:
  1157.  
  1158.     C:/Foo/Bar
  1159.  
  1160.  
  1161.  
  1162.  
  1163.  
  1164.  
  1165. =item RELATIVE
  1166.  
  1167. The RELATIVE flag is used to indicate if templates specified with
  1168. filenames relative to the current directory (e.g. './foo/bar' or
  1169. '../../some/where/else') should be loaded.  It is also disabled by
  1170. default, and will raise a 'file' error if such template names are
  1171. encountered.  
  1172.  
  1173.     my $provider = Template::Provider->new({
  1174.     RELATIVE => 1,
  1175.     });
  1176.  
  1177.     [% INCLUDE ../logs/error.log %]
  1178.  
  1179.  
  1180.  
  1181.  
  1182.  
  1183. =item DEFAULT
  1184.  
  1185. The DEFAULT option can be used to specify a default template which should 
  1186. be used whenever a specified template can't be found in the INCLUDE_PATH.
  1187.  
  1188.     my $provider = Template::Provider->new({
  1189.     DEFAULT => 'notfound.html',
  1190.     });
  1191.  
  1192. If a non-existant template is requested through the Template process()
  1193. method, or by an INCLUDE, PROCESS or WRAPPER directive, then the
  1194. DEFAULT template will instead be processed, if defined.  Note that the
  1195. DEFAULT template is not used when templates are specified with
  1196. absolute or relative filenames, or as a reference to a input file
  1197. handle or text string.
  1198.  
  1199.  
  1200.  
  1201.  
  1202.  
  1203. =item CACHE_SIZE
  1204.  
  1205. The Template::Provider module caches compiled templates to avoid the need
  1206. to re-parse template files or blocks each time they are used.  The CACHE_SIZE
  1207. option is used to limit the number of compiled templates that the module
  1208. should cache.
  1209.  
  1210. By default, the CACHE_SIZE is undefined and all compiled templates are
  1211. cached.  When set to any positive value, the cache will be limited to
  1212. storing no more than that number of compiled templates.  When a new
  1213. template is loaded and compiled and the cache is full (i.e. the number
  1214. of entries == CACHE_SIZE), the least recently used compiled template
  1215. is discarded to make room for the new one.
  1216.  
  1217. The CACHE_SIZE can be set to 0 to disable caching altogether.
  1218.  
  1219.     my $provider = Template::Provider->new({
  1220.     CACHE_SIZE => 64,   # only cache 64 compiled templates
  1221.     });
  1222.  
  1223.     my $provider = Template::Provider->new({
  1224.     CACHE_SIZE => 0,   # don't cache any compiled templates
  1225.     });
  1226.  
  1227.  
  1228.  
  1229.  
  1230.  
  1231.  
  1232. =item COMPILE_EXT
  1233.  
  1234. From version 2 onwards, the Template Toolkit has the ability to
  1235. compile templates to Perl code and save them to disk for subsequent
  1236. use (i.e. cache persistence).  The COMPILE_EXT option may be
  1237. provided to specify a filename extension for compiled template files.
  1238. It is undefined by default and no attempt will be made to read or write 
  1239. any compiled template files.
  1240.  
  1241.     my $provider = Template::Provider->new({
  1242.     COMPILE_EXT => '.ttc',
  1243.     });
  1244.  
  1245. If COMPILE_EXT is defined (and COMPILE_DIR isn't, see below) then compiled
  1246. template files with the COMPILE_EXT extension will be written to the same
  1247. directory from which the source template files were loaded.
  1248.  
  1249. Compiling and subsequent reuse of templates happens automatically
  1250. whenever the COMPILE_EXT or COMPILE_DIR options are set.  The Template
  1251. Toolkit will automatically reload and reuse compiled files when it 
  1252. finds them on disk.  If the corresponding source file has been modified
  1253. since the compiled version as written, then it will load and re-compile
  1254. the source and write a new compiled version to disk.  
  1255.  
  1256. This form of cache persistence offers significant benefits in terms of 
  1257. time and resources required to reload templates.  Compiled templates can
  1258. be reloaded by a simple call to Perl's require(), leaving Perl to handle
  1259. all the parsing and compilation.  This is a Good Thing.
  1260.  
  1261. =item COMPILE_DIR
  1262.  
  1263. The COMPILE_DIR option is used to specify an alternate directory root
  1264. under which compiled template files should be saved.  
  1265.  
  1266.     my $provider = Template::Provider->new({
  1267.     COMPILE_DIR => '/tmp/ttc',
  1268.     });
  1269.  
  1270. The COMPILE_EXT option may also be specified to have a consistent file
  1271. extension added to these files.  
  1272.  
  1273.     my $provider1 = Template::Provider->new({
  1274.     COMPILE_DIR => '/tmp/ttc',
  1275.     COMPILE_EXT => '.ttc1',
  1276.     });
  1277.  
  1278.     my $provider2 = Template::Provider->new({
  1279.     COMPILE_DIR => '/tmp/ttc',
  1280.     COMPILE_EXT => '.ttc2',
  1281.     });
  1282.  
  1283.  
  1284. When COMPILE_EXT is undefined, the compiled template files have the
  1285. same name as the original template files, but reside in a different
  1286. directory tree.
  1287.  
  1288. Each directory in the INCLUDE_PATH is replicated in full beneath the 
  1289. COMPILE_DIR directory.  This example:
  1290.  
  1291.     my $provider = Template::Provider->new({
  1292.     COMPILE_DIR  => '/tmp/ttc',
  1293.     INCLUDE_PATH => '/home/abw/templates:/usr/share/templates',
  1294.     });
  1295.  
  1296. would create the following directory structure:
  1297.  
  1298.     /tmp/ttc/home/abw/templates/
  1299.     /tmp/ttc/usr/share/templates/
  1300.  
  1301. Files loaded from different INCLUDE_PATH directories will have their
  1302. compiled forms save in the relevant COMPILE_DIR directory.
  1303.  
  1304. On Win32 platforms a filename may by prefixed by a drive letter and
  1305. colon.  e.g.
  1306.  
  1307.     C:/My Templates/header
  1308.  
  1309. The colon will be silently stripped from the filename when it is added
  1310. to the COMPILE_DIR value(s) to prevent illegal filename being generated.
  1311. Any colon in COMPILE_DIR elements will be left intact.  For example:
  1312.  
  1313.     # Win32 only
  1314.     my $provider = Template::Provider->new({
  1315.     DELIMITER    => ';',
  1316.     COMPILE_DIR  => 'C:/TT2/Cache',
  1317.     INCLUDE_PATH => 'C:/TT2/Templates;D:/My Templates',
  1318.     });
  1319.  
  1320. This would create the following cache directories:
  1321.  
  1322.     C:/TT2/Cache/C/TT2/Templates
  1323.     C:/TT2/Cache/D/My Templates
  1324.  
  1325.  
  1326.  
  1327.  
  1328. =item TOLERANT
  1329.  
  1330. The TOLERANT flag is used by the various Template Toolkit provider
  1331. modules (Template::Provider, Template::Plugins, Template::Filters) to
  1332. control their behaviour when errors are encountered.  By default, any
  1333. errors are reported as such, with the request for the particular
  1334. resource (template, plugin, filter) being denied and an exception
  1335. raised.  When the TOLERANT flag is set to any true values, errors will
  1336. be silently ignored and the provider will instead return
  1337. STATUS_DECLINED.  This allows a subsequent provider to take
  1338. responsibility for providing the resource, rather than failing the
  1339. request outright.  If all providers decline to service the request,
  1340. either through tolerated failure or a genuine disinclination to
  1341. comply, then a 'E<lt>resourceE<gt> not found' exception is raised.
  1342.  
  1343.  
  1344.  
  1345.  
  1346.  
  1347.  
  1348. =item PARSER
  1349.  
  1350. The Template::Parser module implements a parser object for compiling
  1351. templates into Perl code which can then be executed.  A default object
  1352. of this class is created automatically and then used by the
  1353. Template::Provider whenever a template is loaded and requires 
  1354. compilation.  The PARSER option can be used to provide a reference to 
  1355. an alternate parser object.
  1356.  
  1357.     my $provider = Template::Provider->new({
  1358.     PARSER => MyOrg::Template::Parser->new({ ... }),
  1359.     });
  1360.  
  1361.  
  1362.  
  1363. =item DEBUG
  1364.  
  1365. The DEBUG option can be used to enable debugging messages from the
  1366. Template::Provider module by setting it to include the DEBUG_PROVIDER
  1367. value.
  1368.  
  1369.     use Template::Constants qw( :debug );
  1370.  
  1371.     my $template = Template->new({
  1372.     DEBUG => DEBUG_PROVIDER,
  1373.     });
  1374.  
  1375.  
  1376.  
  1377. =back
  1378.  
  1379. =head2 fetch($name)
  1380.  
  1381. Returns a compiled template for the name specified.  If the template 
  1382. cannot be found then (undef, STATUS_DECLINED) is returned.  If an error
  1383. occurs (e.g. read error, parse error) then ($error, STATUS_ERROR) is 
  1384. returned, where $error is the error message generated.  If the TOLERANT
  1385. flag is set the the method returns (undef, STATUS_DECLINED) instead of
  1386. returning an error.
  1387.  
  1388. =head2 store($name, $template)
  1389.  
  1390. Stores the compiled template, $template, in the cache under the name, 
  1391. $name.  Susbequent calls to fetch($name) will return this template in
  1392. preference to any disk-based file.
  1393.  
  1394. =head2 include_path(\@newpath))
  1395.  
  1396. Accessor method for the INCLUDE_PATH setting.  If called with an
  1397. argument, this method will replace the existing INCLUDE_PATH with
  1398. the new value.
  1399.  
  1400. =head2 paths()
  1401.  
  1402. This method generates a copy of the INCLUDE_PATH list.  Any elements in the
  1403. list which are dynamic generators (e.g. references to subroutines or objects
  1404. implementing a paths() method) will be called and the list of directories 
  1405. returned merged into the output list.
  1406.  
  1407. It is possible to provide a generator which returns itself, thus sending
  1408. this method into an infinite loop.  To detect and prevent this from happening,
  1409. the C<$MAX_DIRS> package variable, set to 64 by default, limits the maximum
  1410. number of paths that can be added to, or generated for the output list.  If
  1411. this number is exceeded then the method will immediately return an error 
  1412. reporting as much.
  1413.  
  1414. =head1 AUTHOR
  1415.  
  1416. Andy Wardley E<lt>abw@andywardley.comE<gt>
  1417.  
  1418. L<http://www.andywardley.com/|http://www.andywardley.com/>
  1419.  
  1420.  
  1421.  
  1422.  
  1423. =head1 VERSION
  1424.  
  1425. 2.79, distributed as part of the
  1426. Template Toolkit version 2.13, released on 30 January 2004.
  1427.  
  1428. =head1 COPYRIGHT
  1429.  
  1430.   Copyright (C) 1996-2004 Andy Wardley.  All Rights Reserved.
  1431.   Copyright (C) 1998-2002 Canon Research Centre Europe Ltd.
  1432.  
  1433. This module is free software; you can redistribute it and/or
  1434. modify it under the same terms as Perl itself.
  1435.  
  1436. =head1 SEE ALSO
  1437.  
  1438. L<Template|Template>, L<Template::Parser|Template::Parser>, L<Template::Context|Template::Context>
  1439.  
  1440. =cut
  1441.  
  1442. # Local Variables:
  1443. # mode: perl
  1444. # perl-indent-level: 4
  1445. # indent-tabs-mode: nil
  1446. # End:
  1447. #
  1448. # vim: expandtab shiftwidth=4:
  1449.