-
Notifications
You must be signed in to change notification settings - Fork 3
/
Copy pathmodperl.pm
63 lines (49 loc) · 1.44 KB
/
modperl.pm
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
package JSToolkit::ModPerl;
use strict;
use vars qw( $VERSION );
use Apache2::Const qw( :common );
use Template::Alloy;
use CGI;
use Cwd;
use File::Basename;
$VERSION = 3.14;
sub handler {
my $r = shift;
return DECLINED
if ! -f $r->filename ||
$r->filename !~ /\.(html?|css|jss?x?)$/;
my $suffix = ".$1";
my $filename = $r->filename;
my $basedir = dirname($filename);
my $q = new CGI;
my $cgivars = $q->Vars;
chdir $basedir;
my $vars = { cgi => $cgivars
};
# create a template processing object
my $template = Template::Alloy->new({
ABSOLUTE => 1,
RELATIVE => 1,
ADD_LOCAL_PATH => 1,
OUTPUT => $r, # direct output to Apache request
EVAL_PERL => 1,
});
# use the path_info to determine which template file to process
my $file = $r->filename;
if ($suffix =~ /\.jss?x$/) {
$r->content_type('text/javascript; charset=UTF-8');
} elsif ($suffix =~ /\.css$/) {
$r->content_type('text/css; charset=UTF-8');
} elsif ($suffix =~ /\.html?$/) {
$r->content_type('text/html; charset=UTF-8');
}
$template->process($file, $vars)
|| return fail($r, SERVER_ERROR, $template->error);
return OK;
}
sub fail {
my ($r, $status, $message) = @_;
$r->log_reason($message, $r->filename);
$r->print("<html><body><h1>ERROR</h1>$message</body></html>");
return OK;
}