comparison Lib/Engine/Output/JSON.pm @ 0:03e58a454b20

Создан репозитарий
author Sergey
date Tue, 14 Jul 2009 12:54:37 +0400
parents
children 16ada169ca75
comparison
equal deleted inserted replaced
-1:000000000000 0:03e58a454b20
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;