File Coverage

blib/lib/CGI/Application/Plugin/TT/LastModified.pm
Criterion Covered Total %
statement 39 41 95.1
branch 5 8 62.5
condition 2 3 66.6
subroutine 8 8 100.0
pod 2 2 100.0
total 56 62 90.3


line stmt bran cond sub pod time code
1             package CGI::Application::Plugin::TT::LastModified;
2              
3             ###############################################################################
4             # Required inclusions.
5             ###############################################################################
6 3     3   321251 use strict;
  3         10  
  3         165  
7 3     3   52 use warnings;
  3         5  
  3         118  
8 3     3   3230 use CGI::Util qw(expires);
  3         10351  
  3         277  
9 3     3   39 use List::Util qw(max);
  3         8  
  3         622  
10              
11             ###############################################################################
12             # Version numbering.
13             ###############################################################################
14             our $VERSION = '1.02';
15              
16             ###############################################################################
17             # Export our methods.
18             ###############################################################################
19             our @EXPORT = qw(
20             tt_last_modified
21             tt_set_last_modified_header
22             );
23              
24             ###############################################################################
25             # Subroutine: import()
26             ###############################################################################
27             # Custom import routine, which allows for 'tt_set_last_modified_header()' to be
28             # auto-added in as a TT post process hook.
29             ###############################################################################
30             sub import {
31 3     3   34 my $pkg = shift;
32 3         8 my $auto = shift;
33 3         7 my $caller = scalar caller;
34              
35             # manually export our symbols
36 3         8 foreach my $sym (@EXPORT) {
37 3     3   19 no strict 'refs';
  3         5  
  3         1357  
38 6         10 *{"${caller}::$sym"} = \&{$sym};
  6         40  
  6         14  
39             }
40              
41             # sanity check caller package, and set up auto-header functionality
42 3 50 66     192 if (not UNIVERSAL::isa($caller, 'CGI::Application')) {
    50          
    100          
43 0         0 warn "Calling package is not a CGI::Application module.\n";
44             }
45             elsif (not UNIVERSAL::can($caller, 'tt_obj')) {
46 0         0 warn "Calling package hasn't imported CGI::Application::Plugin::TT.\n";
47             }
48             elsif ($auto and ($auto eq ':auto')) {
49 1         12 $caller->add_callback( tt_post_process => \&tt_set_last_modified_header );
50             }
51             }
52              
53             ###############################################################################
54             # Subroutine: tt_last_modified()
55             ###############################################################################
56             # Returns the most recent modification time for any component of the most
57             # recently processed template (via 'tt_process()'). Time is returned back to
58             # the caller as "the number of seconds since the epoch".
59             ###############################################################################
60             sub tt_last_modified {
61 2     2 1 5 my $self = shift;
62 2         12 my $ctx = $self->tt_obj->context();
63 2         42 my $mtime = 0;
64 2         5 foreach my $provider (@{$ctx->{'LOAD_TEMPLATES'}}) {
  2         6  
65 2         5 foreach my $file (keys %{$provider->{'LOOKUP'}}) {
  2         9  
66 6         12 my $c_mtime = $provider->{'LOOKUP'}{$file}[3];
67 6         33 $mtime = max( $mtime, $c_mtime );
68             }
69             }
70 2         6 return $mtime;
71             }
72              
73             ###############################################################################
74             # Subroutine: tt_set_last_modified_header()
75             ###############################################################################
76             # Sets a "Last-Modified" header in the HTTP response, equivalent to the last
77             # modification time of the template components as returned by
78             # 'tt_last_modified()'.
79             ###############################################################################
80             sub tt_set_last_modified_header {
81 2     2 1 320674 my $self = shift;
82 2         13 my $mtime = $self->tt_last_modified();
83 2 50       14 if ($mtime) {
84 2         13 my $lastmod = expires( $mtime, 'http' );
85 2         151 $self->header_add( '-last-modified' => $lastmod );
86             }
87             }
88              
89             1;
90              
91             =head1 NAME
92              
93             CGI::Application::Plugin::TT::LastModified - Set "Last-Modified" header based on TT template
94              
95             =head1 SYNOPSIS
96              
97             # when you want to set the "Last-Modified" header manually
98             use base qw(CGI::Application);
99             use CGI::Application::Plugin::TT;
100             use CGI::Application::Plugin::TT::LastModified;
101              
102             sub my_runmode {
103             my $self = shift;
104             my %params = (
105             ...
106             );
107             my $html = $self->tt_process( 'template.html', \%params );
108             $self->tt_set_last_modified_header();
109             return $html;
110             }
111              
112             # when you want the "Last-Modified" header set automatically
113             use base qw(CGI::Application);
114             use CGI::Application::Plugin::TT;
115             use CGI::Application::Plugin::TT::LastModified qw(:auto);
116              
117             sub my_runmode {
118             my $self = shift;
119             my %params = (
120             ...
121             );
122             return $self->tt_process( 'template.html', \%params );
123             }
124              
125             =head1 DESCRIPTION
126              
127             C adds support to
128             C for setting a "Last-Modified" header based on the most
129             recent modification time of I of the components of a template that was
130             processed with TT.
131              
132             Normally you'll want to call it manually, on as "as needed" basis; if you're
133             processing templates with TT you're most likely dealing with dynamic content
134             (in which case you probably don't even want a "Last-Modified" header). The odd
135             time you'll want to set a "Last-Modified" header, though, this plugin helps
136             make that easier.
137              
138             B you have a desire to have the "Last-Modified" header set automatically
139             for you, though, C does have an
140             C<:auto> import tag which auto-registers L as a
141             "tt_post_process" hook for you. If you've got an app that just processes
142             static TT pages and generates output, this'll be useful for you.
143              
144             =head1 METHODS
145              
146             =over
147              
148             =item import()
149              
150             Custom import routine, which allows for C to
151             be auto-added in as a TT post process hook.
152              
153             =item tt_last_modified()
154              
155             Returns the most recent modification time for any component of the most
156             recently processed template (via C). Time is returned back to
157             the caller as "the number of seconds since the epoch".
158              
159             =item tt_set_last_modified_header()
160              
161             Sets a "Last-Modified" header in the HTTP response, equivalent to the last
162             modification time of the template components as returned by
163             C.
164              
165             =back
166              
167             =head1 AUTHOR
168              
169             Graham TerMarsch (cpan@howlingfrog.com)
170              
171             =head1 COPYRIGHT
172              
173             Copyright (C) 2007, Graham TerMarsch. All Rights Reserved.
174              
175             This is free software; you can redistribute it and/or modify it under the same
176             terms as Perl itself.
177              
178             =head1 SEE ALSO
179              
180             L,
181             L,
182             L