line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package TemplateM; # $Id: TemplateM.pm 10 2013-07-08 14:37:29Z abalama $
|
2
|
6
|
|
|
6
|
|
148750
|
use strict;
|
|
6
|
|
|
|
|
19
|
|
|
6
|
|
|
|
|
939
|
|
3
|
|
|
|
|
|
|
|
4
|
|
|
|
|
|
|
=head1 NAME
|
5
|
|
|
|
|
|
|
|
6
|
|
|
|
|
|
|
TemplateM - *ML templates processing module
|
7
|
|
|
|
|
|
|
|
8
|
|
|
|
|
|
|
=head1 VERSION
|
9
|
|
|
|
|
|
|
|
10
|
|
|
|
|
|
|
Version 3.03
|
11
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
=head1 SYNOPSIS
|
13
|
|
|
|
|
|
|
|
14
|
|
|
|
|
|
|
use TemplateM;
|
15
|
|
|
|
|
|
|
use TemplateM 'simple';
|
16
|
|
|
|
|
|
|
|
17
|
|
|
|
|
|
|
my $template = new TemplateM(
|
18
|
|
|
|
|
|
|
-url => 'http://localhost/foo.shtml',
|
19
|
|
|
|
|
|
|
-utf8 => 1,
|
20
|
|
|
|
|
|
|
);
|
21
|
|
|
|
|
|
|
|
22
|
|
|
|
|
|
|
my $template = new TemplateM( -file => 'ftp://login:password@192.168.1.1/foo.shtml' );
|
23
|
|
|
|
|
|
|
my $template = new TemplateM( -file => 'foo.shtml' );
|
24
|
|
|
|
|
|
|
my $template = new TemplateM( -file => \*DATA );
|
25
|
|
|
|
|
|
|
|
26
|
|
|
|
|
|
|
# GALORE (DEFAULT):
|
27
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
my $block = $template->start( 'block_label' );
|
29
|
|
|
|
|
|
|
$block->loop( foo => 'value1', bar => 'value2', ... );
|
30
|
|
|
|
|
|
|
|
31
|
|
|
|
|
|
|
$template->stash( foo => 'value1', bar => 'value2', ... );
|
32
|
|
|
|
|
|
|
$block->stash( baz => 'value1', ... );
|
33
|
|
|
|
|
|
|
|
34
|
|
|
|
|
|
|
$template->ifelse( "ifblock_label", $predicate )
|
35
|
|
|
|
|
|
|
$block->ifelse( "ifblock_label", $predicate )
|
36
|
|
|
|
|
|
|
|
37
|
|
|
|
|
|
|
print $block->output;
|
38
|
|
|
|
|
|
|
|
39
|
|
|
|
|
|
|
$block->finish;
|
40
|
|
|
|
|
|
|
|
41
|
|
|
|
|
|
|
print $template->output;
|
42
|
|
|
|
|
|
|
print $template->html( "Content-type: text/html\n\n" );
|
43
|
|
|
|
|
|
|
|
44
|
|
|
|
|
|
|
# OBSOLETE:
|
45
|
|
|
|
|
|
|
|
46
|
|
|
|
|
|
|
$template->cast( {foo => 'value1', bar => 'value2', ... } );
|
47
|
|
|
|
|
|
|
my %h = ( ... );
|
48
|
|
|
|
|
|
|
$template->cast( \%h );
|
49
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
$template->cast_loop ( "block_label", {foo => 'value1', bar => 'value2', ... } );
|
51
|
|
|
|
|
|
|
$template->finalize ( "block_label" );
|
52
|
|
|
|
|
|
|
|
53
|
|
|
|
|
|
|
$template->cast_if( "block_label", $predicate );
|
54
|
|
|
|
|
|
|
|
55
|
|
|
|
|
|
|
=head1 ABSTRACT
|
56
|
|
|
|
|
|
|
|
57
|
|
|
|
|
|
|
The TemplateM module means for text templates processing in XML, HTML, TEXT and so on formats.
|
58
|
|
|
|
|
|
|
TemplateM is the alternative to most of standard modules, and it can accomplish remote access
|
59
|
|
|
|
|
|
|
to template files, has simple syntax, small size and flexibility. Then you use TemplateM,
|
60
|
|
|
|
|
|
|
functionality and data are completely separated, this is quality of up-to-date web-projects.
|
61
|
|
|
|
|
|
|
|
62
|
|
|
|
|
|
|
=head1 TERMS
|
63
|
|
|
|
|
|
|
|
64
|
|
|
|
|
|
|
=head2 Scheme
|
65
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
Set of methods prodiving process template's structures.
|
67
|
|
|
|
|
|
|
|
68
|
|
|
|
|
|
|
=head2 Template
|
69
|
|
|
|
|
|
|
|
70
|
|
|
|
|
|
|
File or array of data which represents the set of instructions, directives and tags of markup
|
71
|
|
|
|
|
|
|
languages and statistics.
|
72
|
|
|
|
|
|
|
|
73
|
|
|
|
|
|
|
=head2 Directive
|
74
|
|
|
|
|
|
|
|
75
|
|
|
|
|
|
|
Name of structure in a template for substitution. There are a number of directives:
|
76
|
|
|
|
|
|
|
|
77
|
|
|
|
|
|
|
cgi, val, do, loop, if, endif, else, endelse
|
78
|
|
|
|
|
|
|
|
79
|
|
|
|
|
|
|
=head2 Structure
|
80
|
|
|
|
|
|
|
|
81
|
|
|
|
|
|
|
Structure is the tag or the group of tags in a template which defining a scope of substitution.
|
82
|
|
|
|
|
|
|
The structure consist of tag and formatted content:
|
83
|
|
|
|
|
|
|
|
84
|
|
|
|
|
|
|
DIRECTIVE: LABEL
|
85
|
|
|
|
|
|
|
|
86
|
|
|
|
|
|
|
The structure can be simple or complex. Simple one is like this:
|
87
|
|
|
|
|
|
|
|
88
|
|
|
|
|
|
|
|
89
|
|
|
|
|
|
|
or
|
90
|
|
|
|
|
|
|
|
91
|
|
|
|
|
|
|
|
92
|
|
|
|
|
|
|
Complex structure is the group of simple structures which constitutive a "section"
|
93
|
|
|
|
|
|
|
|
94
|
|
|
|
|
|
|
|
95
|
|
|
|
|
|
|
...
|
96
|
|
|
|
|
|
|
|
97
|
|
|
|
|
|
|
...
|
98
|
|
|
|
|
|
|
|
99
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
even so:
|
101
|
|
|
|
|
|
|
|
102
|
|
|
|
|
|
|
|
103
|
|
|
|
|
|
|
...
|
104
|
|
|
|
|
|
|
|
105
|
|
|
|
|
|
|
|
106
|
|
|
|
|
|
|
...
|
107
|
|
|
|
|
|
|
|
108
|
|
|
|
|
|
|
|
109
|
|
|
|
|
|
|
=head2 Label
|
110
|
|
|
|
|
|
|
|
111
|
|
|
|
|
|
|
This is identifier of structure. E.g. foo, bar, baz
|
112
|
|
|
|
|
|
|
|
113
|
|
|
|
|
|
|
|
114
|
|
|
|
|
|
|
|
115
|
|
|
|
|
|
|
=head1 DESCRIPTION
|
116
|
|
|
|
|
|
|
|
117
|
|
|
|
|
|
|
=head2 SCHEMES
|
118
|
|
|
|
|
|
|
|
119
|
|
|
|
|
|
|
While defining use it can specify 2 accessible schemes - galore (default) or simple.
|
120
|
|
|
|
|
|
|
It is not obligatory to point at default scheme.
|
121
|
|
|
|
|
|
|
|
122
|
|
|
|
|
|
|
Simple scheme is basic and defines using of basic methods:
|
123
|
|
|
|
|
|
|
|
124
|
|
|
|
|
|
|
C
|
125
|
|
|
|
|
|
|
|
126
|
|
|
|
|
|
|
Simple scheme methods is expedient for small-datasize projects.
|
127
|
|
|
|
|
|
|
|
128
|
|
|
|
|
|
|
Galore (default) scheme is the alternative for base scheme and it defines own set of methods:
|
129
|
|
|
|
|
|
|
|
130
|
|
|
|
|
|
|
C
|
131
|
|
|
|
|
|
|
|
132
|
|
|
|
|
|
|
In order to get knowing which of schemes is activated you need to invoke methods either module()
|
133
|
|
|
|
|
|
|
or scheme()
|
134
|
|
|
|
|
|
|
|
135
|
|
|
|
|
|
|
my $module = $template->module;
|
136
|
|
|
|
|
|
|
my $module = $template->scheme;
|
137
|
|
|
|
|
|
|
|
138
|
|
|
|
|
|
|
In order to get know real module name of the used scheme it's enough to read property 'module'
|
139
|
|
|
|
|
|
|
of $template object
|
140
|
|
|
|
|
|
|
|
141
|
|
|
|
|
|
|
my $module = $template->{module};
|
142
|
|
|
|
|
|
|
|
143
|
|
|
|
|
|
|
=head2 CONSTRUCTOR
|
144
|
|
|
|
|
|
|
|
145
|
|
|
|
|
|
|
Constructor new() is the principal method independent of selected scheme. Almost simple way to use
|
146
|
|
|
|
|
|
|
the constructor is:
|
147
|
|
|
|
|
|
|
|
148
|
|
|
|
|
|
|
my $template = new TemplateM( -template => "blah-blah-blah" );
|
149
|
|
|
|
|
|
|
|
150
|
|
|
|
|
|
|
This invoking takes directive to use simple text as template.
|
151
|
|
|
|
|
|
|
|
152
|
|
|
|
|
|
|
Below is the attribute list of constructor:
|
153
|
|
|
|
|
|
|
|
154
|
|
|
|
|
|
|
=over 8
|
155
|
|
|
|
|
|
|
|
156
|
|
|
|
|
|
|
=item B
|
157
|
|
|
|
|
|
|
|
158
|
|
|
|
|
|
|
B designates either path or filehandle to file is passed for reading from disk, bypassing
|
159
|
|
|
|
|
|
|
the method of remote obtaining of a template.
|
160
|
|
|
|
|
|
|
|
161
|
|
|
|
|
|
|
=item B
|
162
|
|
|
|
|
|
|
|
163
|
|
|
|
|
|
|
B is the absolute or relative path to directory for cache files storage. This directory needs
|
164
|
|
|
|
|
|
|
to have a permission to read and write files.
|
165
|
|
|
|
|
|
|
When B is missed caching is disabled. Caching on is recommended for faster module operations.
|
166
|
|
|
|
|
|
|
|
167
|
|
|
|
|
|
|
=item B
|
168
|
|
|
|
|
|
|
|
169
|
|
|
|
|
|
|
B is the filename, opened filehandler (GLOB) or locations of a template.
|
170
|
|
|
|
|
|
|
Supports relative or absolute pathes,
|
171
|
|
|
|
|
|
|
and also template file locator. Relative path can forestall with ./ prefix or without it.
|
172
|
|
|
|
|
|
|
Absolute path must be forestall with / prefix. Template file locator is the URI formatted string.
|
173
|
|
|
|
|
|
|
If the file is missed, it use "index.shtml" from current directory as default value.
|
174
|
|
|
|
|
|
|
|
175
|
|
|
|
|
|
|
Value represent "Uniform Resource Identifier references" as specified in RFC 2396 (and updated
|
176
|
|
|
|
|
|
|
by RFC 2732). See L for details.
|
177
|
|
|
|
|
|
|
|
178
|
|
|
|
|
|
|
=item B |
179
|
|
|
|
|
|
|
|
180
|
|
|
|
|
|
|
B uses as value by default before main content template print (method html).
|
181
|
|
|
|
|
|
|
|
182
|
|
|
|
|
|
|
my $template = new TemplateM( -header => "Content-type: text/html; charset=UTF-8\n\n");
|
183
|
|
|
|
|
|
|
print $template->html;
|
184
|
|
|
|
|
|
|
|
185
|
|
|
|
|
|
|
=item B
|
186
|
|
|
|
|
|
|
|
187
|
|
|
|
|
|
|
B and B are data for standard HTTP-authorization.
|
188
|
|
|
|
|
|
|
Login and password will be used when the template defined via locator and when remote access is
|
189
|
|
|
|
|
|
|
protected by HTTP-authorization of remote server. When user_login is missed the access to remote
|
190
|
|
|
|
|
|
|
template file realizes simplified scheme, without basic HTTP-authorization.
|
191
|
|
|
|
|
|
|
|
192
|
|
|
|
|
|
|
=item B
|
193
|
|
|
|
|
|
|
|
194
|
|
|
|
|
|
|
B points to method of remote HTTP/HTTPS access to template page. Can take values: "GET",
|
195
|
|
|
|
|
|
|
"HEAD", "PUT" or "POST". HEAD methods can be used only for headers getting.
|
196
|
|
|
|
|
|
|
|
197
|
|
|
|
|
|
|
=item B
|
198
|
|
|
|
|
|
|
|
199
|
|
|
|
|
|
|
B turn UTF8 mode for access to a file. The flag allow to get rid of a forced setting utf-8
|
200
|
|
|
|
|
|
|
flag for properties template and work by method Encode::_utf8_on()
|
201
|
|
|
|
|
|
|
|
202
|
|
|
|
|
|
|
=item B
|
203
|
|
|
|
|
|
|
|
204
|
|
|
|
|
|
|
B (template). This attribute has to be defined when template content is not
|
205
|
|
|
|
|
|
|
able to get from a file or get it from remote locations. E.g. it has to be defined when
|
206
|
|
|
|
|
|
|
a template selects from a database. Defining of this attribute means disabling of
|
207
|
|
|
|
|
|
|
precompile result caching!
|
208
|
|
|
|
|
|
|
|
209
|
|
|
|
|
|
|
=item B
|
210
|
|
|
|
|
|
|
|
211
|
|
|
|
|
|
|
B is the period of cache file keeping in integer seconds.
|
212
|
|
|
|
|
|
|
When the value is missed cache file "compiles" once and will be used as template.
|
213
|
|
|
|
|
|
|
Positive value has an effect only then template file is dynamic and it changes in time.
|
214
|
|
|
|
|
|
|
Previous versions of the module sets value 20 instead 0 by default.
|
215
|
|
|
|
|
|
|
It had to set the value -1 for "compilation" disabling.
|
216
|
|
|
|
|
|
|
For current version of the module value can be 0 or every positive number. 0 is
|
217
|
|
|
|
|
|
|
equivalent -1 of previous versions of the module.
|
218
|
|
|
|
|
|
|
|
219
|
|
|
|
|
|
|
=item B
|
220
|
|
|
|
|
|
|
|
221
|
|
|
|
|
|
|
B is the pointer to the subroutine must be invoked for HTTP::Request object
|
222
|
|
|
|
|
|
|
after creation via method new.
|
223
|
|
|
|
|
|
|
|
224
|
|
|
|
|
|
|
Sample:
|
225
|
|
|
|
|
|
|
|
226
|
|
|
|
|
|
|
-reqcode => sub {
|
227
|
|
|
|
|
|
|
my $req = shift;
|
228
|
|
|
|
|
|
|
...
|
229
|
|
|
|
|
|
|
$req-> ...
|
230
|
|
|
|
|
|
|
...
|
231
|
|
|
|
|
|
|
return 1;
|
232
|
|
|
|
|
|
|
}
|
233
|
|
|
|
|
|
|
|
234
|
|
|
|
|
|
|
=item B
|
235
|
|
|
|
|
|
|
|
236
|
|
|
|
|
|
|
B is the pointer to the subroutine must be invoked for HTTP::Response after
|
237
|
|
|
|
|
|
|
creation via calling $ua->request($req).
|
238
|
|
|
|
|
|
|
|
239
|
|
|
|
|
|
|
Sample:
|
240
|
|
|
|
|
|
|
|
241
|
|
|
|
|
|
|
-rescode => sub {
|
242
|
|
|
|
|
|
|
my $res = shift;
|
243
|
|
|
|
|
|
|
...
|
244
|
|
|
|
|
|
|
$res-> ...
|
245
|
|
|
|
|
|
|
...
|
246
|
|
|
|
|
|
|
return 1;
|
247
|
|
|
|
|
|
|
}
|
248
|
|
|
|
|
|
|
|
249
|
|
|
|
|
|
|
=item B
|
250
|
|
|
|
|
|
|
|
251
|
|
|
|
|
|
|
B is the pointer to the subroutine must be invoked for LWP::UserAgent after
|
252
|
|
|
|
|
|
|
creation via method new().
|
253
|
|
|
|
|
|
|
|
254
|
|
|
|
|
|
|
Sample:
|
255
|
|
|
|
|
|
|
|
256
|
|
|
|
|
|
|
-uacode => sub {
|
257
|
|
|
|
|
|
|
my $ua = shift;
|
258
|
|
|
|
|
|
|
...
|
259
|
|
|
|
|
|
|
$ua-> ...
|
260
|
|
|
|
|
|
|
...
|
261
|
|
|
|
|
|
|
return 1;
|
262
|
|
|
|
|
|
|
}
|
263
|
|
|
|
|
|
|
|
264
|
|
|
|
|
|
|
=item B
|
265
|
|
|
|
|
|
|
|
266
|
|
|
|
|
|
|
B is the pointer to the hash containing options for defining parameters of
|
267
|
|
|
|
|
|
|
UserAgent object's constructor. (See LWP::UserAgent)
|
268
|
|
|
|
|
|
|
|
269
|
|
|
|
|
|
|
Example:
|
270
|
|
|
|
|
|
|
|
271
|
|
|
|
|
|
|
-uaopts => {
|
272
|
|
|
|
|
|
|
agent => "Mozilla/4.0",
|
273
|
|
|
|
|
|
|
max_redirect => 10,
|
274
|
|
|
|
|
|
|
requests_redirectable => ['GET','HEAD','POST'],
|
275
|
|
|
|
|
|
|
protocols_allowed => ['http', 'https'], # Required Crypt::SSLeay
|
276
|
|
|
|
|
|
|
cookie_jar => new HTTP::Cookies(
|
277
|
|
|
|
|
|
|
file => File::Spec->catfile("/foo/bar/_cookies.dat"),
|
278
|
|
|
|
|
|
|
autosave => 1
|
279
|
|
|
|
|
|
|
),
|
280
|
|
|
|
|
|
|
conn_cache => new LWP::ConnCache(),
|
281
|
|
|
|
|
|
|
}
|
282
|
|
|
|
|
|
|
|
283
|
|
|
|
|
|
|
=back
|
284
|
|
|
|
|
|
|
|
285
|
|
|
|
|
|
|
=head2 SIMPLE SCHEME METHODS (BASIC METHODS)
|
286
|
|
|
|
|
|
|
|
287
|
|
|
|
|
|
|
It is enough to define the module with 'simple' parameter for using of basic methods.
|
288
|
|
|
|
|
|
|
|
289
|
|
|
|
|
|
|
use TemplateM 'simple';
|
290
|
|
|
|
|
|
|
|
291
|
|
|
|
|
|
|
After that only basic metods will be automatically enabled.
|
292
|
|
|
|
|
|
|
|
293
|
|
|
|
|
|
|
=head3 cast
|
294
|
|
|
|
|
|
|
|
295
|
|
|
|
|
|
|
Modification of labels (cgi labels)
|
296
|
|
|
|
|
|
|
|
297
|
|
|
|
|
|
|
$template->cast({label1=>value1, label2=>value2, ... });
|
298
|
|
|
|
|
|
|
|
299
|
|
|
|
|
|
|
=over 8
|
300
|
|
|
|
|
|
|
|
301
|
|
|
|
|
|
|
=item B |
302
|
|
|
|
|
|
|
|
303
|
|
|
|
|
|
|
B |
304
|
|
|
|
|
|
|
|
305
|
|
|
|
|
|
|
=item B
|
306
|
|
|
|
|
|
|
|
307
|
|
|
|
|
|
|
B - Value, which CGI-script sets. Member of the L |
308
|
|
|
|
|
|
|
|
309
|
|
|
|
|
|
|
=back
|
310
|
|
|
|
|
|
|
|
311
|
|
|
|
|
|
|
=head3 cast_loop
|
312
|
|
|
|
|
|
|
|
313
|
|
|
|
|
|
|
Block labels modification (val labels)
|
314
|
|
|
|
|
|
|
|
315
|
|
|
|
|
|
|
$template->cast_loop (block_label, {label1=>value1, label2=>value2, ... }]);
|
316
|
|
|
|
|
|
|
|
317
|
|
|
|
|
|
|
=over 8
|
318
|
|
|
|
|
|
|
|
319
|
|
|
|
|
|
|
=item block_label
|
320
|
|
|
|
|
|
|
|
321
|
|
|
|
|
|
|
B - Block identification name.
|
322
|
|
|
|
|
|
|
The name will be inserted in tags and - all content
|
323
|
|
|
|
|
|
|
between this tags processes like labels, but the tag will be formed as
|
324
|
|
|
|
|
|
|
|
325
|
|
|
|
|
|
|
=back
|
326
|
|
|
|
|
|
|
|
327
|
|
|
|
|
|
|
=head3 finalize
|
328
|
|
|
|
|
|
|
|
329
|
|
|
|
|
|
|
Block finalizing
|
330
|
|
|
|
|
|
|
|
331
|
|
|
|
|
|
|
$template->finalize(block_label);
|
332
|
|
|
|
|
|
|
|
333
|
|
|
|
|
|
|
Block finalizing uses for not-processed blocks deleting. You need use finalizing every time you use blockes.
|
334
|
|
|
|
|
|
|
|
335
|
|
|
|
|
|
|
=head3 cast_if
|
336
|
|
|
|
|
|
|
|
337
|
|
|
|
|
|
|
$template->cast_if(ifblock_label, predicate);
|
338
|
|
|
|
|
|
|
|
339
|
|
|
|
|
|
|
Method analyses boolean value of predicate. If value is true, the method prints if-structure content only.
|
340
|
|
|
|
|
|
|
|
341
|
|
|
|
|
|
|
|
342
|
|
|
|
|
|
|
... blah blah blah ...
|
343
|
|
|
|
|
|
|
|
344
|
|
|
|
|
|
|
|
345
|
|
|
|
|
|
|
otherwise the method prints else-structure content only.
|
346
|
|
|
|
|
|
|
|
347
|
|
|
|
|
|
|
|
348
|
|
|
|
|
|
|
... blah blah blah ...
|
349
|
|
|
|
|
|
|
|
350
|
|
|
|
|
|
|
|
351
|
|
|
|
|
|
|
=head3 html
|
352
|
|
|
|
|
|
|
|
353
|
|
|
|
|
|
|
Template finalizing
|
354
|
|
|
|
|
|
|
|
355
|
|
|
|
|
|
|
print $template->html(-header=>HTTP_header);
|
356
|
|
|
|
|
|
|
print $template->html(HTTP_header);
|
357
|
|
|
|
|
|
|
print $template->html;
|
358
|
|
|
|
|
|
|
|
359
|
|
|
|
|
|
|
The procedure will return formed document after template processing.
|
360
|
|
|
|
|
|
|
if header is present as argument it will be added at the beginning of template's return.
|
361
|
|
|
|
|
|
|
|
362
|
|
|
|
|
|
|
=head2 GALORE SCHEME METHODS (DEFAULT)
|
363
|
|
|
|
|
|
|
|
364
|
|
|
|
|
|
|
It is enough to define the module with parameter 'galore' for using of galore scheme methods.
|
365
|
|
|
|
|
|
|
|
366
|
|
|
|
|
|
|
use TemplateM;
|
367
|
|
|
|
|
|
|
use TemplateM 'galore';
|
368
|
|
|
|
|
|
|
|
369
|
|
|
|
|
|
|
=head3 stash
|
370
|
|
|
|
|
|
|
|
371
|
|
|
|
|
|
|
stash (or cast) method is the function of import variables value into template.
|
372
|
|
|
|
|
|
|
|
373
|
|
|
|
|
|
|
$template->stash(title => 'PI' , pi => 3.1415926);
|
374
|
|
|
|
|
|
|
|
375
|
|
|
|
|
|
|
This example demonstrate how all of and structures
|
376
|
|
|
|
|
|
|
will be replaced by parameters of stash method invoking.
|
377
|
|
|
|
|
|
|
|
378
|
|
|
|
|
|
|
In contrast to default scheme, in galore scheme stash method process directives only
|
379
|
|
|
|
|
|
|
with defined labels when invoking, whereas cast method of default scheme precess all of
|
380
|
|
|
|
|
|
|
directives in template!
|
381
|
|
|
|
|
|
|
|
382
|
|
|
|
|
|
|
=head3 start and finish
|
383
|
|
|
|
|
|
|
|
384
|
|
|
|
|
|
|
Start method defines the beginning of loop, and finish method defines the end.
|
385
|
|
|
|
|
|
|
Start method returns reference to the subtemplate object, that is all between do and loop directives.
|
386
|
|
|
|
|
|
|
|
387
|
|
|
|
|
|
|
|
388
|
|
|
|
|
|
|
... blah blah blah ...
|
389
|
|
|
|
|
|
|
|
390
|
|
|
|
|
|
|
|
391
|
|
|
|
|
|
|
|
392
|
|
|
|
|
|
|
... blah blah blah ...
|
393
|
|
|
|
|
|
|
|
394
|
|
|
|
|
|
|
|
395
|
|
|
|
|
|
|
my $block = $template->start(block_label);
|
396
|
|
|
|
|
|
|
...
|
397
|
|
|
|
|
|
|
$block->finish;
|
398
|
|
|
|
|
|
|
|
399
|
|
|
|
|
|
|
For acces to val directives it is necessary to use loop method, and for access to cgi directives use stash method.
|
400
|
|
|
|
|
|
|
|
401
|
|
|
|
|
|
|
=head3 loop
|
402
|
|
|
|
|
|
|
|
403
|
|
|
|
|
|
|
The method takes as parameters a hash of arguments or a reference to this hash.
|
404
|
|
|
|
|
|
|
|
405
|
|
|
|
|
|
|
$block->loop(label1 => 'A', label2 => 'B');
|
406
|
|
|
|
|
|
|
$block->loop({label1 => 'A', label2 => 'B'});
|
407
|
|
|
|
|
|
|
|
408
|
|
|
|
|
|
|
Stash method also can be invoked in $block object context.
|
409
|
|
|
|
|
|
|
|
410
|
|
|
|
|
|
|
$block->stash(label => 3.1415926);
|
411
|
|
|
|
|
|
|
|
412
|
|
|
|
|
|
|
=head3 ifelse
|
413
|
|
|
|
|
|
|
|
414
|
|
|
|
|
|
|
$template->ifelse("ifblock_label", $predicate)
|
415
|
|
|
|
|
|
|
$block->ifelse("ifblock_label", $predicate)
|
416
|
|
|
|
|
|
|
|
417
|
|
|
|
|
|
|
Method is equal to cast_if method of default scheme. The difference, ifelse method
|
418
|
|
|
|
|
|
|
can be processed with $template or $block, whereas cast_if method has deal with $template object.
|
419
|
|
|
|
|
|
|
|
420
|
|
|
|
|
|
|
=head3 output
|
421
|
|
|
|
|
|
|
|
422
|
|
|
|
|
|
|
The method returns result of template processing. Output method has deal with $template and $block object:
|
423
|
|
|
|
|
|
|
|
424
|
|
|
|
|
|
|
$block->output;
|
425
|
|
|
|
|
|
|
$template->output;
|
426
|
|
|
|
|
|
|
|
427
|
|
|
|
|
|
|
=head3 html
|
428
|
|
|
|
|
|
|
|
429
|
|
|
|
|
|
|
The method is completely equal to html method of default scheme.
|
430
|
|
|
|
|
|
|
|
431
|
|
|
|
|
|
|
=head2 EXAMPLE
|
432
|
|
|
|
|
|
|
|
433
|
|
|
|
|
|
|
In test.pl file:
|
434
|
|
|
|
|
|
|
|
435
|
|
|
|
|
|
|
use TemplateM;
|
436
|
|
|
|
|
|
|
|
437
|
|
|
|
|
|
|
my $tpl = new TemplateM(
|
438
|
|
|
|
|
|
|
-file => 'test.tpl',
|
439
|
|
|
|
|
|
|
-asfile => 1,
|
440
|
|
|
|
|
|
|
);
|
441
|
|
|
|
|
|
|
|
442
|
|
|
|
|
|
|
$tpl->stash(
|
443
|
|
|
|
|
|
|
module => (split(/\=/,"$tpl"))[0],
|
444
|
|
|
|
|
|
|
version => $tpl->VERSION,
|
445
|
|
|
|
|
|
|
scheme => $tpl->scheme()." / ".$tpl->{module},
|
446
|
|
|
|
|
|
|
date => scalar(localtime(time())),
|
447
|
|
|
|
|
|
|
);
|
448
|
|
|
|
|
|
|
|
449
|
|
|
|
|
|
|
my $row_box = $tpl->start('row');
|
450
|
|
|
|
|
|
|
foreach my $row ('A'..'F') {
|
451
|
|
|
|
|
|
|
$row_box->loop({});
|
452
|
|
|
|
|
|
|
my $col_box = $row_box->start('col');
|
453
|
|
|
|
|
|
|
foreach my $col (1...6) {
|
454
|
|
|
|
|
|
|
$col_box->loop( foo => $row.$col );
|
455
|
|
|
|
|
|
|
$col_box->cast_if(div=>(
|
456
|
|
|
|
|
|
|
('A'..'F')[$col-1] ne $row
|
457
|
|
|
|
|
|
|
&&
|
458
|
|
|
|
|
|
|
('A'..'F')[6-$col] ne $row
|
459
|
|
|
|
|
|
|
));
|
460
|
|
|
|
|
|
|
}
|
461
|
|
|
|
|
|
|
$col_box->finish;
|
462
|
|
|
|
|
|
|
}
|
463
|
|
|
|
|
|
|
$row_box->finish;
|
464
|
|
|
|
|
|
|
|
465
|
|
|
|
|
|
|
binmode STDOUT, ':raw';
|
466
|
|
|
|
|
|
|
print $tpl->output();
|
467
|
|
|
|
|
|
|
|
468
|
|
|
|
|
|
|
In test.tpl file:
|
469
|
|
|
|
|
|
|
|
470
|
|
|
|
|
|
|
**********************
|
471
|
|
|
|
|
|
|
* *
|
472
|
|
|
|
|
|
|
* Simple text file *
|
473
|
|
|
|
|
|
|
* *
|
474
|
|
|
|
|
|
|
**********************
|
475
|
|
|
|
|
|
|
|
476
|
|
|
|
|
|
|
Table
|
477
|
|
|
|
|
|
|
=====
|
478
|
|
|
|
|
|
|
|
479
|
|
|
|
|
|
|
+-----------------+
|
480
|
|
|
|
|
|
|
|
|
481
|
|
|
|
|
|
|
|
|
482
|
|
|
|
|
|
|
+-----------------+
|
483
|
|
|
|
|
|
|
|
484
|
|
|
|
|
|
|
Data
|
485
|
|
|
|
|
|
|
====
|
486
|
|
|
|
|
|
|
|
487
|
|
|
|
|
|
|
Module :
|
488
|
|
|
|
|
|
|
Version :
|
489
|
|
|
|
|
|
|
Scheme :
|
490
|
|
|
|
|
|
|
Current date :
|
491
|
|
|
|
|
|
|
|
492
|
|
|
|
|
|
|
Result:
|
493
|
|
|
|
|
|
|
|
494
|
|
|
|
|
|
|
**********************
|
495
|
|
|
|
|
|
|
* *
|
496
|
|
|
|
|
|
|
* Simple text file *
|
497
|
|
|
|
|
|
|
* *
|
498
|
|
|
|
|
|
|
**********************
|
499
|
|
|
|
|
|
|
|
500
|
|
|
|
|
|
|
Table
|
501
|
|
|
|
|
|
|
=====
|
502
|
|
|
|
|
|
|
|
503
|
|
|
|
|
|
|
+-----------------+
|
504
|
|
|
|
|
|
|
| |A2|A3|A4|A5| |
|
505
|
|
|
|
|
|
|
+-----------------+
|
506
|
|
|
|
|
|
|
|B1| |B3|B4| |B6|
|
507
|
|
|
|
|
|
|
+-----------------+
|
508
|
|
|
|
|
|
|
|C1|C2| | |C5|C6|
|
509
|
|
|
|
|
|
|
+-----------------+
|
510
|
|
|
|
|
|
|
|D1|D2| | |D5|D6|
|
511
|
|
|
|
|
|
|
+-----------------+
|
512
|
|
|
|
|
|
|
|E1| |E3|E4| |E6|
|
513
|
|
|
|
|
|
|
+-----------------+
|
514
|
|
|
|
|
|
|
| |F2|F3|F4|F5| |
|
515
|
|
|
|
|
|
|
+-----------------+
|
516
|
|
|
|
|
|
|
|
517
|
|
|
|
|
|
|
Data
|
518
|
|
|
|
|
|
|
====
|
519
|
|
|
|
|
|
|
|
520
|
|
|
|
|
|
|
Module : TemplateM
|
521
|
|
|
|
|
|
|
Version : 3.02
|
522
|
|
|
|
|
|
|
Scheme : galore / GaloreWin32
|
523
|
|
|
|
|
|
|
Current date : Sat Dec 18 12:37:10 2010
|
524
|
|
|
|
|
|
|
|
525
|
|
|
|
|
|
|
=head2 TEMPLATEM'S AND SSI DIRECTIVES
|
526
|
|
|
|
|
|
|
|
527
|
|
|
|
|
|
|
The module can be used with SSI directives together, like in this shtml-sample:
|
528
|
|
|
|
|
|
|
|
529
|
|
|
|
|
|
|
|
530
|
|
|
|
|
|
|
|
531
|
|
|
|
|
|
|
|
532
|
|
|
|
|
|
|
|
533
|
|
|
|
|
|
|
|
534
|
|
|
|
|
|
|
|
535
|
|
|
|
|
|
|
|
536
|
|
|
|
|
|
|
|
537
|
|
|
|
|
|
|
|
538
|
|
|
|
|
|
|
|
539
|
|
|
|
|
|
|
=head1 ENVIRONMENT
|
540
|
|
|
|
|
|
|
|
541
|
|
|
|
|
|
|
No environment variables are used.
|
542
|
|
|
|
|
|
|
|
543
|
|
|
|
|
|
|
=head1 BUGS
|
544
|
|
|
|
|
|
|
|
545
|
|
|
|
|
|
|
Please report them.
|
546
|
|
|
|
|
|
|
|
547
|
|
|
|
|
|
|
=head1 SEE ALSO
|
548
|
|
|
|
|
|
|
|
549
|
|
|
|
|
|
|
L, L
|
550
|
|
|
|
|
|
|
|
551
|
|
|
|
|
|
|
=head1 DIAGNOSTICS
|
552
|
|
|
|
|
|
|
|
553
|
|
|
|
|
|
|
The usual warnings if it cannot read or write the files involved.
|
554
|
|
|
|
|
|
|
|
555
|
|
|
|
|
|
|
=head1 HISTORY
|
556
|
|
|
|
|
|
|
|
557
|
|
|
|
|
|
|
=over 8
|
558
|
|
|
|
|
|
|
|
559
|
|
|
|
|
|
|
=item B<1.00 / 01.05.2006>
|
560
|
|
|
|
|
|
|
|
561
|
|
|
|
|
|
|
Init version
|
562
|
|
|
|
|
|
|
|
563
|
|
|
|
|
|
|
=back
|
564
|
|
|
|
|
|
|
|
565
|
|
|
|
|
|
|
See C file for details
|
566
|
|
|
|
|
|
|
|
567
|
|
|
|
|
|
|
=head1 TO DO
|
568
|
|
|
|
|
|
|
|
569
|
|
|
|
|
|
|
See C file
|
570
|
|
|
|
|
|
|
|
571
|
|
|
|
|
|
|
=head1 THANKS
|
572
|
|
|
|
|
|
|
|
573
|
|
|
|
|
|
|
Thanks to Dmitry Klimov for technical translating L.
|
574
|
|
|
|
|
|
|
|
575
|
|
|
|
|
|
|
=head1 AUTHOR
|
576
|
|
|
|
|
|
|
|
577
|
|
|
|
|
|
|
Serz Minus (Lepenkov Sergey) L Eminus@mail333.comE
|
578
|
|
|
|
|
|
|
|
579
|
|
|
|
|
|
|
=head1 COPYRIGHTS
|
580
|
|
|
|
|
|
|
|
581
|
|
|
|
|
|
|
Copyright (C) 1998-2013 D&D Corporation. All Rights Reserved
|
582
|
|
|
|
|
|
|
|
583
|
|
|
|
|
|
|
=head1 LICENSE
|
584
|
|
|
|
|
|
|
|
585
|
|
|
|
|
|
|
This program is free software; you can redistribute it and/or modify it under the same terms and
|
586
|
|
|
|
|
|
|
conditions as Perl itself.
|
587
|
|
|
|
|
|
|
|
588
|
|
|
|
|
|
|
=cut
|
589
|
|
|
|
|
|
|
|
590
|
6
|
|
|
6
|
|
39
|
use vars qw($VERSION);
|
|
6
|
|
|
|
|
10
|
|
|
6
|
|
|
|
|
515
|
|
591
|
|
|
|
|
|
|
our $VERSION = 3.03;
|
592
|
|
|
|
|
|
|
our @ISA;
|
593
|
|
|
|
|
|
|
|
594
|
6
|
|
|
6
|
|
22131
|
use Encode;
|
|
6
|
|
|
|
|
95062
|
|
|
6
|
|
|
|
|
599
|
|
595
|
6
|
|
|
6
|
|
53
|
use Carp qw/croak confess carp cluck/;
|
|
6
|
|
|
|
|
10
|
|
|
6
|
|
|
|
|
471
|
|
596
|
6
|
|
|
6
|
|
30
|
use File::Spec;
|
|
6
|
|
|
|
|
11
|
|
|
6
|
|
|
|
|
122
|
|
597
|
|
|
|
|
|
|
|
598
|
6
|
|
|
6
|
|
3174
|
use TemplateM::Util;
|
|
6
|
|
|
|
|
14
|
|
|
6
|
|
|
|
|
303
|
|
599
|
|
|
|
|
|
|
|
600
|
6
|
|
|
6
|
|
39507
|
use URI;
|
|
6
|
|
|
|
|
61485
|
|
|
6
|
|
|
|
|
204
|
|
601
|
6
|
|
|
6
|
|
36460
|
use LWP::UserAgent;
|
|
6
|
|
|
|
|
339773
|
|
|
6
|
|
|
|
|
241
|
|
602
|
6
|
|
|
6
|
|
66
|
use HTTP::Request;
|
|
6
|
|
|
|
|
14
|
|
|
6
|
|
|
|
|
162
|
|
603
|
6
|
|
|
6
|
|
47
|
use HTTP::Response;
|
|
6
|
|
|
|
|
13
|
|
|
6
|
|
|
|
|
128
|
|
604
|
6
|
|
|
6
|
|
31
|
use HTTP::Headers;
|
|
6
|
|
|
|
|
11
|
|
|
6
|
|
|
|
|
1897
|
|
605
|
|
|
|
|
|
|
|
606
|
|
|
|
|
|
|
my $mpflag = 0;
|
607
|
|
|
|
|
|
|
if (exists $ENV{MOD_PERL}) {
|
608
|
|
|
|
|
|
|
if (exists $ENV{MOD_PERL_API_VERSION} && $ENV{MOD_PERL_API_VERSION} == 2) {
|
609
|
|
|
|
|
|
|
$mpflag = 2;
|
610
|
|
|
|
|
|
|
require Apache2::Response;
|
611
|
|
|
|
|
|
|
require Apache2::RequestRec;
|
612
|
|
|
|
|
|
|
require Apache2::RequestUtil;
|
613
|
|
|
|
|
|
|
require Apache2::RequestIO;
|
614
|
|
|
|
|
|
|
require Apache2::ServerRec;
|
615
|
|
|
|
|
|
|
require APR::Pool;
|
616
|
|
|
|
|
|
|
} else {
|
617
|
|
|
|
|
|
|
$mpflag = 1;
|
618
|
|
|
|
|
|
|
require Apache;
|
619
|
|
|
|
|
|
|
}
|
620
|
|
|
|
|
|
|
}
|
621
|
|
|
|
|
|
|
|
622
|
|
|
|
|
|
|
my $os = $^O || 'Unix';
|
623
|
|
|
|
|
|
|
my %modules = (
|
624
|
|
|
|
|
|
|
galore => ($os eq 'MSWin32' or $os eq 'NetWare') ? "GaloreWin32" : "Galore",
|
625
|
|
|
|
|
|
|
simple => "Simple",
|
626
|
|
|
|
|
|
|
);
|
627
|
|
|
|
|
|
|
my $module;
|
628
|
|
|
|
|
|
|
|
629
|
|
|
|
|
|
|
sub import {
|
630
|
6
|
|
|
6
|
|
76
|
my ($class, @args) = @_;
|
631
|
6
|
|
100
|
|
|
33
|
my $mdl = shift(@args) || 'default';
|
632
|
6
|
|
66
|
|
|
32
|
$module = $modules{lc($mdl)} || $modules{galore};
|
633
|
6
|
|
|
|
|
3826
|
require "TemplateM/$module.pm";
|
634
|
6
|
|
|
|
|
1974
|
@ISA = ("TemplateM::$module");
|
635
|
|
|
|
|
|
|
}
|
636
|
|
|
|
|
|
|
|
637
|
6
|
|
|
6
|
|
14040
|
BEGIN {
|
638
|
0
|
|
|
0
|
0
|
0
|
sub errstamp { "[".(caller(1))[3]."]" }
|
639
|
|
|
|
|
|
|
}
|
640
|
|
|
|
|
|
|
|
641
|
|
|
|
|
|
|
sub new {
|
642
|
6
|
|
|
6
|
0
|
320
|
my $class = shift;
|
643
|
6
|
|
|
|
|
19
|
my @arg = @_;
|
644
|
|
|
|
|
|
|
|
645
|
|
|
|
|
|
|
# GET Args
|
646
|
6
|
|
|
|
|
11
|
my ($file, $login, $password, $cachedir, $timeout, $header, $template,
|
647
|
|
|
|
|
|
|
$asfile, $onutf8, $method, $uaopt, $uacode, $reqcode, $rescode);
|
648
|
6
|
50
|
|
|
|
154
|
($file, $login, $password, $cachedir, $timeout, $header, $template,
|
649
|
|
|
|
|
|
|
$asfile, $onutf8, $method, $uaopt, $uacode, $reqcode, $rescode) = read_attributes(
|
650
|
|
|
|
|
|
|
[
|
651
|
|
|
|
|
|
|
[qw/FILE FILENAME URL URI/],
|
652
|
|
|
|
|
|
|
[qw/LOGIN USER/],
|
653
|
|
|
|
|
|
|
[qw/PASSWORD PASSWD PASS/],
|
654
|
|
|
|
|
|
|
[qw/CACHE CACHEFILE CACHEDIR/],
|
655
|
|
|
|
|
|
|
[qw/TIMEOUT TIME INTERVAL/],
|
656
|
|
|
|
|
|
|
[qw/HEAD HEADER/],
|
657
|
|
|
|
|
|
|
[qw/TEMPLATE TPL TMPL TPLT TMPLT CONTENT DATA/],
|
658
|
|
|
|
|
|
|
|
659
|
|
|
|
|
|
|
[qw/ASFILE ONFILE/],
|
660
|
|
|
|
|
|
|
[qw/UTF8 UTF-8 ONUTF8 ASUTF8 UTF8ON UTF8_ON ON_UTF8 USEUTF8/],
|
661
|
|
|
|
|
|
|
[qw/METH METHOD/], # "GET", "HEAD", "PUT" or "POST".
|
662
|
|
|
|
|
|
|
[qw/UAOPT UAOPTS UAOPTION UAOPTIONS UAPARAMS/],
|
663
|
|
|
|
|
|
|
|
664
|
|
|
|
|
|
|
[qw/UACODE/],
|
665
|
|
|
|
|
|
|
[qw/REQCODE/],
|
666
|
|
|
|
|
|
|
[qw/RESCODE/],
|
667
|
|
|
|
|
|
|
|
668
|
|
|
|
|
|
|
], @arg ) if defined $arg[0];
|
669
|
|
|
|
|
|
|
|
670
|
|
|
|
|
|
|
# DEFAULTS & BLESS
|
671
|
6
|
|
100
|
|
|
56
|
$file ||= 'index.shtml';
|
672
|
6
|
|
|
|
|
14
|
my $url = ''; # URL resource
|
673
|
6
|
|
|
|
|
12
|
my $cache = '';
|
674
|
6
|
100
|
|
|
|
21
|
if (ref $file eq 'GLOB') {
|
675
|
3
|
|
|
|
|
7
|
$asfile = 1;
|
676
|
|
|
|
|
|
|
} else {
|
677
|
3
|
|
|
|
|
12
|
$cache = _get_cachefile($cachedir, $file);
|
678
|
|
|
|
|
|
|
}
|
679
|
|
|
|
|
|
|
|
680
|
6
|
100
|
|
|
|
22
|
unless (defined $template) {
|
681
|
3
|
50
|
|
|
|
9
|
if ($asfile) {
|
682
|
3
|
|
|
|
|
14
|
$template = _load_file($file, $onutf8);
|
683
|
|
|
|
|
|
|
} else {
|
684
|
0
|
0
|
|
|
|
0
|
if ( _timeout_ok($cache, $timeout) ) {
|
685
|
0
|
0
|
|
|
|
0
|
if ($file =~/^\//) { # abs path (/foo/bar/baz)
|
|
|
0
|
|
|
|
|
|
686
|
0
|
|
|
|
|
0
|
$url = _get_uri($file, 0);
|
687
|
|
|
|
|
|
|
} elsif ($file =~/^\w+\:\/\//) { # Full URL (http://foo/bar/baz)
|
688
|
0
|
|
|
|
|
0
|
$url = $file;
|
689
|
|
|
|
|
|
|
} else { # relation or other (foo/bar/baz)
|
690
|
0
|
|
|
|
|
0
|
$url = _get_uri($file, 1);
|
691
|
|
|
|
|
|
|
}
|
692
|
|
|
|
|
|
|
|
693
|
0
|
|
|
|
|
0
|
$template = _load_url(
|
694
|
|
|
|
|
|
|
$url, $login, $password, $onutf8, $method,
|
695
|
|
|
|
|
|
|
$uaopt, $uacode, $reqcode, $rescode
|
696
|
|
|
|
|
|
|
);
|
697
|
0
|
0
|
|
|
|
0
|
if ($cache) {
|
698
|
0
|
0
|
|
|
|
0
|
if ($template eq '') {
|
699
|
0
|
|
|
|
|
0
|
$template = _load_cache($cache, $onutf8);
|
700
|
|
|
|
|
|
|
} else {
|
701
|
0
|
|
|
|
|
0
|
_save_cache($cache, $onutf8, $template);
|
702
|
|
|
|
|
|
|
}
|
703
|
|
|
|
|
|
|
}
|
704
|
|
|
|
|
|
|
} else {
|
705
|
0
|
0
|
|
|
|
0
|
$template = _load_cache($cache, $onutf8) if $cache;
|
706
|
|
|
|
|
|
|
}
|
707
|
|
|
|
|
|
|
}
|
708
|
|
|
|
|
|
|
}
|
709
|
|
|
|
|
|
|
|
710
|
6
|
50
|
|
|
|
41
|
$template = '' unless defined($template);
|
711
|
6
|
50
|
|
|
|
29
|
Encode::_utf8_on($template) if $onutf8;
|
712
|
|
|
|
|
|
|
|
713
|
6
|
50
|
|
|
|
32
|
my $stk = $modules{galore} eq "GaloreWin32" ? [] : '';
|
714
|
|
|
|
|
|
|
|
715
|
6
|
|
50
|
|
|
247
|
my $self = bless {
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
716
|
|
|
|
|
|
|
timeout => $timeout || 0,
|
717
|
|
|
|
|
|
|
file => $file || '',
|
718
|
|
|
|
|
|
|
url => $url,
|
719
|
|
|
|
|
|
|
login => $login || '',
|
720
|
|
|
|
|
|
|
password => $password || '',
|
721
|
|
|
|
|
|
|
cachedir => $cachedir || '',
|
722
|
|
|
|
|
|
|
cache => $cache || '',
|
723
|
|
|
|
|
|
|
template => $template,
|
724
|
|
|
|
|
|
|
header => $header || '',
|
725
|
|
|
|
|
|
|
module => $module || '',
|
726
|
|
|
|
|
|
|
# Galore
|
727
|
|
|
|
|
|
|
work => $template,
|
728
|
|
|
|
|
|
|
stackout => $stk,
|
729
|
|
|
|
|
|
|
looparr => {}
|
730
|
|
|
|
|
|
|
}, $class;
|
731
|
|
|
|
|
|
|
|
732
|
6
|
|
|
|
|
27
|
return $self;
|
733
|
|
|
|
|
|
|
}
|
734
|
|
|
|
|
|
|
sub module {
|
735
|
4
|
|
|
4
|
0
|
8
|
my $self = shift;
|
736
|
4
|
|
|
|
|
25
|
my %hm = reverse %modules;
|
737
|
4
|
|
|
|
|
31
|
lc($hm{$self->{module}})
|
738
|
|
|
|
|
|
|
}
|
739
|
4
|
|
|
4
|
0
|
2563
|
sub scheme { goto &module }
|
740
|
0
|
|
|
0
|
0
|
0
|
sub schema { goto &module }
|
741
|
|
|
|
|
|
|
sub AUTOLOAD {
|
742
|
0
|
|
|
0
|
|
0
|
my $self = shift;
|
743
|
0
|
|
|
|
|
0
|
$self->html(@_)
|
744
|
|
|
|
|
|
|
}
|
745
|
|
|
|
|
|
|
sub DESTROY {
|
746
|
6
|
|
|
6
|
|
1901
|
my $self = shift;
|
747
|
6
|
|
|
|
|
512
|
undef($self);
|
748
|
|
|
|
|
|
|
}
|
749
|
|
|
|
|
|
|
|
750
|
|
|
|
|
|
|
sub _load_url {
|
751
|
0
|
|
0
|
0
|
|
0
|
my $url = shift || '';
|
752
|
0
|
|
0
|
|
|
0
|
my $login = shift || '';
|
753
|
0
|
|
0
|
|
|
0
|
my $password = shift || '';
|
754
|
0
|
|
0
|
|
|
0
|
my $onutf8 = shift || 0;
|
755
|
0
|
|
0
|
|
|
0
|
my $method = shift || 'GET';
|
756
|
0
|
|
0
|
|
|
0
|
my $uaopt = shift || {};
|
757
|
0
|
|
0
|
|
|
0
|
my $uscode = shift || undef;
|
758
|
0
|
|
0
|
|
|
0
|
my $reqcode = shift || undef;
|
759
|
0
|
|
0
|
|
|
0
|
my $rescode = shift || undef;
|
760
|
|
|
|
|
|
|
|
761
|
0
|
|
|
|
|
0
|
my $html = '';
|
762
|
0
|
|
|
|
|
0
|
my $uri_url = new URI($url);
|
763
|
|
|
|
|
|
|
|
764
|
0
|
|
|
|
|
0
|
my $ua = new LWP::UserAgent(%$uaopt);
|
765
|
0
|
0
|
0
|
|
|
0
|
$uscode->($ua) if ($uscode && ref($uscode) eq 'CODE');
|
766
|
0
|
|
|
|
|
0
|
my $req = new HTTP::Request(uc($method), $uri_url);
|
767
|
0
|
0
|
|
|
|
0
|
$req->authorization_basic($login, $password) if $login;
|
768
|
0
|
0
|
0
|
|
|
0
|
$reqcode->($req) if ($reqcode && ref($reqcode) eq 'CODE');
|
769
|
0
|
|
|
|
|
0
|
my $res = $ua->request($req);
|
770
|
0
|
0
|
0
|
|
|
0
|
$rescode->($res) if ($rescode && ref($rescode) eq 'CODE');
|
771
|
0
|
0
|
|
|
|
0
|
if ($res->is_success) {
|
772
|
0
|
0
|
|
|
|
0
|
if ($onutf8) {
|
773
|
0
|
|
|
|
|
0
|
$html = $res->decoded_content;
|
774
|
0
|
0
|
|
|
|
0
|
$html = '' unless defined($html);
|
775
|
0
|
|
|
|
|
0
|
Encode::_utf8_on($html);
|
776
|
|
|
|
|
|
|
} else {
|
777
|
0
|
|
|
|
|
0
|
$html = $res->content;
|
778
|
0
|
0
|
|
|
|
0
|
$html = '' unless defined($html);
|
779
|
|
|
|
|
|
|
}
|
780
|
|
|
|
|
|
|
} else {
|
781
|
0
|
|
|
|
|
0
|
carp(errstamp," An error occurred while trying to obtain the resource \"$url\" (",$res->status_line,")");
|
782
|
|
|
|
|
|
|
}
|
783
|
|
|
|
|
|
|
|
784
|
0
|
|
|
|
|
0
|
return $html;
|
785
|
|
|
|
|
|
|
}
|
786
|
|
|
|
|
|
|
sub _save_cache {
|
787
|
0
|
|
0
|
0
|
|
0
|
my $cf = shift || '';
|
788
|
0
|
|
|
|
|
0
|
my $onutf8 = shift;
|
789
|
0
|
|
0
|
|
|
0
|
my $content = shift || '';
|
790
|
0
|
|
|
|
|
0
|
my $OUT;
|
791
|
|
|
|
|
|
|
|
792
|
0
|
|
|
|
|
0
|
my $flc = 0;
|
793
|
0
|
0
|
|
|
|
0
|
if (ref $cf eq 'GLOB') {
|
794
|
0
|
|
|
|
|
0
|
$OUT = $cf;
|
795
|
|
|
|
|
|
|
} else {
|
796
|
0
|
0
|
|
|
|
0
|
open $OUT, '>', $cf or croak(errstamp," An error occurred while trying to write in file \"$cf\" ($!)");
|
797
|
0
|
0
|
|
|
|
0
|
flock $OUT, 2 or croak(errstamp," An error occurred while blocking in file \"$cf\" ($!)");
|
798
|
0
|
|
|
|
|
0
|
$flc = 1;
|
799
|
|
|
|
|
|
|
}
|
800
|
|
|
|
|
|
|
|
801
|
0
|
0
|
|
|
|
0
|
binmode $OUT, ':raw:utf8' if $onutf8;
|
802
|
0
|
0
|
|
|
|
0
|
binmode $OUT unless $onutf8;
|
803
|
0
|
|
|
|
|
0
|
print $OUT $content;
|
804
|
0
|
0
|
|
|
|
0
|
close $OUT if $flc;
|
805
|
0
|
|
|
|
|
0
|
return 1;
|
806
|
|
|
|
|
|
|
}
|
807
|
|
|
|
|
|
|
sub _load_cache {
|
808
|
0
|
|
0
|
0
|
|
0
|
my $cf = shift || '';
|
809
|
0
|
|
|
|
|
0
|
my $onutf8 = shift;
|
810
|
0
|
|
|
|
|
0
|
my $IN;
|
811
|
|
|
|
|
|
|
|
812
|
0
|
0
|
0
|
|
|
0
|
if ($cf && -e $cf) {
|
813
|
0
|
0
|
|
|
|
0
|
if (ref $cf eq 'GLOB') {
|
814
|
0
|
|
|
|
|
0
|
$IN = $cf;
|
815
|
|
|
|
|
|
|
} else {
|
816
|
0
|
0
|
|
|
|
0
|
open $IN, '<', $cf or croak(errstamp," An error occurred while trying to read from file \"$cf\" ($!)");
|
817
|
|
|
|
|
|
|
}
|
818
|
0
|
0
|
|
|
|
0
|
binmode $IN, ':raw:utf8' if $onutf8;
|
819
|
0
|
0
|
|
|
|
0
|
binmode $IN unless $onutf8;
|
820
|
0
|
|
|
|
|
0
|
my $outdata = scalar(do { local $/; <$IN> });
|
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
821
|
0
|
0
|
|
|
|
0
|
Encode::_utf8_on($outdata) if $onutf8;
|
822
|
0
|
|
|
|
|
0
|
close $IN;
|
823
|
0
|
|
|
|
|
0
|
return $outdata;
|
824
|
|
|
|
|
|
|
} else {
|
825
|
0
|
|
|
|
|
0
|
carp(errstamp," An error occurred while opening file \"$cf\" ($!)");
|
826
|
|
|
|
|
|
|
}
|
827
|
0
|
|
|
|
|
0
|
return '';
|
828
|
|
|
|
|
|
|
}
|
829
|
|
|
|
|
|
|
sub _load_file {
|
830
|
3
|
|
50
|
3
|
|
13
|
my $fn = shift || '';
|
831
|
3
|
|
|
|
|
7
|
my $onutf8 = shift;
|
832
|
3
|
|
|
|
|
4
|
my $IN;
|
833
|
|
|
|
|
|
|
|
834
|
3
|
50
|
|
|
|
12
|
if (ref $fn eq 'GLOB') {
|
835
|
3
|
|
|
|
|
6
|
$IN = $fn;
|
836
|
|
|
|
|
|
|
} else {
|
837
|
0
|
0
|
|
|
|
0
|
open $IN, '<', $fn or croak(errstamp," An error occurred while trying to read from file \"$fn\" ($!)");
|
838
|
|
|
|
|
|
|
}
|
839
|
3
|
50
|
|
|
|
10
|
binmode $IN, ':raw:utf8' if $onutf8;
|
840
|
3
|
50
|
|
|
|
36
|
binmode $IN unless $onutf8;
|
841
|
3
|
|
|
|
|
5
|
my $outdata = scalar(do { local $/; <$IN> });
|
|
3
|
|
|
|
|
9
|
|
|
3
|
|
|
|
|
106
|
|
842
|
3
|
50
|
|
|
|
14
|
Encode::_utf8_on($outdata) if $onutf8;
|
843
|
3
|
|
|
|
|
40
|
close $IN;
|
844
|
3
|
|
|
|
|
12
|
return $outdata;
|
845
|
|
|
|
|
|
|
}
|
846
|
|
|
|
|
|
|
sub _timeout_ok {
|
847
|
0
|
|
0
|
0
|
|
0
|
my $cachefile = shift || '';
|
848
|
0
|
|
0
|
|
|
0
|
my $timeout = shift || 0;
|
849
|
|
|
|
|
|
|
|
850
|
0
|
0
|
0
|
|
|
0
|
return 1 unless $cachefile && -e $cachefile;
|
851
|
|
|
|
|
|
|
|
852
|
0
|
|
|
|
|
0
|
my @statfile = stat($cachefile);
|
853
|
|
|
|
|
|
|
|
854
|
0
|
0
|
|
|
|
0
|
return 0 unless $timeout;
|
855
|
|
|
|
|
|
|
|
856
|
0
|
0
|
|
|
|
0
|
if ((time()-$statfile[9]) > $timeout) {
|
857
|
0
|
|
|
|
|
0
|
return 1;
|
858
|
|
|
|
|
|
|
} else {
|
859
|
0
|
|
|
|
|
0
|
return 0;
|
860
|
|
|
|
|
|
|
}
|
861
|
|
|
|
|
|
|
}
|
862
|
|
|
|
|
|
|
sub _get_cachefile {
|
863
|
3
|
|
|
3
|
|
6
|
my ($dir, $file) = @_;
|
864
|
3
|
50
|
|
|
|
13
|
return '' unless $dir;
|
865
|
|
|
|
|
|
|
|
866
|
0
|
|
|
|
|
|
$file=~s/[.\/\\:?&%]/_/g;
|
867
|
|
|
|
|
|
|
|
868
|
0
|
|
|
|
|
|
return File::Spec->catfile($dir,$file)
|
869
|
|
|
|
|
|
|
}
|
870
|
|
|
|
|
|
|
sub _get_uri {
|
871
|
0
|
|
0
|
0
|
|
|
my $file = shift || '';
|
872
|
0
|
|
0
|
|
|
|
my $tp = shift || 0;
|
873
|
0
|
0
|
|
|
|
|
return '' unless $file;
|
874
|
|
|
|
|
|
|
|
875
|
0
|
|
0
|
|
|
|
my $request_uri = $ENV{REQUEST_URI} || '';
|
876
|
0
|
|
0
|
|
|
|
my $hostname = $ENV{HTTP_HOST} || '';
|
877
|
0
|
|
0
|
|
|
|
my $server_port = $ENV{SERVER_PORT} || '';
|
878
|
|
|
|
|
|
|
|
879
|
0
|
|
|
|
|
|
my $r;
|
880
|
0
|
0
|
|
|
|
|
if ($mpflag) {
|
881
|
0
|
0
|
|
|
|
|
if ($mpflag == 2) {
|
|
|
0
|
|
|
|
|
|
882
|
|
|
|
|
|
|
# mod_perl 2
|
883
|
0
|
|
|
|
|
|
eval('$r = Apache2::RequestUtil->request()');
|
884
|
|
|
|
|
|
|
} elsif ($mpflag == 1) {
|
885
|
|
|
|
|
|
|
# mod_perl 1
|
886
|
0
|
|
|
|
|
|
eval('$r = Apache->request()');
|
887
|
|
|
|
|
|
|
}
|
888
|
0
|
|
|
|
|
|
$request_uri = $r->uri();
|
889
|
0
|
|
|
|
|
|
$hostname = $r->hostname();
|
890
|
0
|
|
|
|
|
|
$server_port = $r->server->port();
|
891
|
|
|
|
|
|
|
|
892
|
|
|
|
|
|
|
# Artifact #137: correct hostname value
|
893
|
0
|
0
|
0
|
|
|
|
if ($server_port && $server_port !~ /^(80|443)$/) {
|
894
|
0
|
0
|
0
|
|
|
|
if ($hostname && $hostname !~ /\:\d+$/) {
|
895
|
0
|
|
|
|
|
|
$hostname = $hostname . ':'. $server_port;
|
896
|
|
|
|
|
|
|
}
|
897
|
|
|
|
|
|
|
}
|
898
|
|
|
|
|
|
|
}
|
899
|
|
|
|
|
|
|
|
900
|
0
|
|
|
|
|
|
$request_uri =~ s/\?.+$//;
|
901
|
0
|
0
|
|
|
|
|
$request_uri = ($request_uri =~ /^\/(.+\/).*/ ? $1 : '');
|
902
|
|
|
|
|
|
|
|
903
|
0
|
|
|
|
|
|
my $url = "http://";
|
904
|
0
|
0
|
|
|
|
|
$url = "https://" if $server_port eq '443';
|
905
|
|
|
|
|
|
|
|
906
|
0
|
0
|
|
|
|
|
if ($tp == 1) {
|
907
|
|
|
|
|
|
|
# 1 - relation path or other (foo/bar/baz)
|
908
|
0
|
|
|
|
|
|
$file =~ s/^\.?\/+//;
|
909
|
0
|
0
|
|
|
|
|
if ($hostname) {
|
910
|
0
|
|
|
|
|
|
$url .= $hostname.'/'.$request_uri.$file;
|
911
|
|
|
|
|
|
|
} else {
|
912
|
0
|
|
|
|
|
|
$url = "file://$file";
|
913
|
|
|
|
|
|
|
}
|
914
|
|
|
|
|
|
|
} else {
|
915
|
|
|
|
|
|
|
# 0 - absolute path (/foo/bar/baz)
|
916
|
0
|
0
|
|
|
|
|
if ($hostname) {
|
917
|
0
|
|
|
|
|
|
$url .= $hostname.$file;
|
918
|
|
|
|
|
|
|
} else {
|
919
|
0
|
|
|
|
|
|
$url = "file:/$file";
|
920
|
|
|
|
|
|
|
}
|
921
|
|
|
|
|
|
|
}
|
922
|
|
|
|
|
|
|
|
923
|
0
|
|
|
|
|
|
return $url;
|
924
|
|
|
|
|
|
|
}
|
925
|
|
|
|
|
|
|
|
926
|
|
|
|
|
|
|
1;
|
927
|
|
|
|
|
|
|
|
928
|
|
|
|
|
|
|
__END__
|