annotate Lib/Engine/Output/JSON.pm @ 32:56cef8e3cda6

+1
author Sergey
date Mon, 09 Nov 2009 01:39:31 +0300
parents 03e58a454b20
children 16ada169ca75
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
0
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
1 package Configuration;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
2 our $HtDocsDir;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
3
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
4 package Engine;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
5 our $Encoding;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
6
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
7 package Engine::Output::JSON;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
8 use strict;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
9 use warnings;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
10
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
11 use Encode;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
12 use PerlIO;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
13 use IMPL::Exception;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
14 use JSON;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
15
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
16 sub CTX_TEMPLATE() { 1 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
17 sub CTX_DATA() { 2 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
18
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
19 my $context = CTX_DATA;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
20 our $Data;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
21
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
22 sub template() { $context = CTX_TEMPLATE }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
23 sub data() { $context = CTX_DATA }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
24
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
25 sub Print {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
26 my ($class,$query,$action) = @_;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
27
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
28 my @path = $action->RequestURI->path_segments;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
29 shift @path;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
30
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
31 my $result;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
32
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
33 undef $@;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
34 $Data = $action->Result;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
35 eval {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
36 my $fname = $HtDocsDir . join '/', @path;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
37 if ($context == CTX_DATA) {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
38 my $dummy = '';
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
39 open my $hstd, ">>", \$dummy or die new IMPL::Exception('Failed to create inmemory stream');
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
40 local (*STDIN,*STDOUT) = ($hstd,$hstd);
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
41 local ${^ENCODING};
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
42 $result = do $fname or die new IMPL::Exception('Failed to evalute the file', $@, $!,$fname);
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
43 } else {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
44 die new IMPL::Exception('JSON templates not implemented');
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
45 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
46 };
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
47 if ($@) {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
48 $result = { errorCode => 1, errorMessage => "$@"};
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
49 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
50
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
51 print $query->header(-status => 200, -type => 'text/javascript');
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
52 print to_json({ errorCode => 0, result => $result });
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
53 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
54
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
55
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
56 1;