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. |
183
|
|
|
|
|
|
|
|
184
|
|
|
|
|
|
|
=cut |