|
49
|
1 package Configuration;
|
|
|
2 our $HtDocsDir;
|
|
|
3
|
|
|
4 package Engine;
|
|
|
5 our $Encoding;
|
|
|
6
|
|
|
7 package Engine::Output::JSON;
|
|
|
8 use strict;
|
|
|
9 use warnings;
|
|
|
10
|
|
|
11 use Encode;
|
|
|
12 use PerlIO;
|
|
|
13 use IMPL::Exception;
|
|
|
14 use JSON;
|
|
|
15
|
|
|
16 sub CTX_TEMPLATE() { 1 }
|
|
|
17 sub CTX_DATA() { 2 }
|
|
|
18
|
|
|
19 my $context = CTX_DATA;
|
|
|
20 our $Data;
|
|
|
21
|
|
|
22 sub template() { $context = CTX_TEMPLATE }
|
|
|
23 sub data() { $context = CTX_DATA }
|
|
|
24
|
|
|
25 sub Print {
|
|
|
26 my ($class,$query,$action) = @_;
|
|
|
27
|
|
|
28 my @path = $action->RequestURI->path_segments;
|
|
|
29 shift @path;
|
|
|
30
|
|
|
31 my $result;
|
|
|
32
|
|
|
33 undef $@;
|
|
|
34 $Data = $action->Result;
|
|
|
35 eval {
|
|
|
36 my $fname = $HtDocsDir . join '/', @path;
|
|
|
37 if ($context == CTX_DATA) {
|
|
|
38 my $dummy = '';
|
|
|
39 open my $hstd, ">>", \$dummy or die new IMPL::Exception('Failed to create inmemory stream');
|
|
|
40 local (*STDIN,*STDOUT) = ($hstd,$hstd);
|
|
|
41 local ${^ENCODING};
|
|
|
42 $result = do $fname or die new IMPL::Exception('Failed to evalute the file', $@, $!,$fname);
|
|
|
43 } else {
|
|
|
44 die new IMPL::Exception('JSON templates not implemented');
|
|
|
45 }
|
|
|
46 };
|
|
|
47 if ($@) {
|
|
|
48 $result = { errorCode => 1, errorMessage => "$@"};
|
|
|
49 }
|
|
|
50
|
|
|
51 print $query->header(-status => 200, -type => 'text/javascript');
|
|
|
52 print to_json({ errorCode => 0, result => $result });
|
|
|
53 }
|
|
|
54
|
|
|
55
|
|
|
56 1;
|
