|
119
|
1 use strict;
|
|
|
2 package IMPL::Transform::Json;
|
|
|
3
|
|
118
|
4 package IMPL::Web::QueryHandler::JsonFormat;
|
|
|
5 use base qw(IMPL::Web::QueryHandler);
|
|
|
6 use Error qw(:try);
|
|
|
7 use JSON;
|
|
|
8
|
|
|
9 sub Process {
|
|
|
10 my ($this,$action,$nextHandler) = @_;
|
|
|
11
|
|
119
|
12 my $result;
|
|
|
13 my $t = new IMPL::Transform::Json;
|
|
118
|
14
|
|
|
15 try {
|
|
|
16 $result = $nextHandler->();
|
|
119
|
17 $result = [$result] unless ref $result;
|
|
118
|
18 } otherwise {
|
|
|
19 my $err = shift;
|
|
|
20 $result = { error => $err };
|
|
|
21 };
|
|
|
22
|
|
|
23 $action->response->contentType('text/javascript');
|
|
119
|
24
|
|
118
|
25 my $hout = $action->response->streamBody;
|
|
119
|
26 print $hout to_json( $t->Transform($result), {pretty => 1} );
|
|
|
27 }
|
|
118
|
28
|
|
119
|
29 package IMPL::Transform::Json;
|
|
118
|
30
|
|
|
31 use base qw(IMPL::Transform);
|
|
|
32 use IMPL::Class::Property;
|
|
119
|
33 my %propListCache;
|
|
118
|
34
|
|
|
35 our %CTOR = (
|
|
|
36 'IMPL::Transform' => sub {
|
|
119
|
37 ARRAY => sub {
|
|
|
38 my ($this,$object) = @_;
|
|
|
39
|
|
|
40 return [
|
|
|
41 map { $this->Transform($_) } @$object
|
|
|
42 ];
|
|
|
43 },
|
|
|
44 HASH => sub {
|
|
|
45 my ($this,$object) = @_;
|
|
|
46
|
|
|
47 return {
|
|
|
48 map { $_, $this->Transform($object->{$_}) } keys %$object
|
|
|
49 };
|
|
|
50 },
|
|
|
51 'IMPL::Object::List' => sub {
|
|
|
52 my ($this,$object) = @_;
|
|
|
53
|
|
|
54 return [
|
|
|
55 map { $this->Transform($_) } @$object
|
|
|
56 ];
|
|
|
57 },
|
|
|
58 'IMPL::Exception' => sub {
|
|
118
|
59 my ($this,$object) = @_;
|
|
119
|
60
|
|
|
61 return {
|
|
|
62 type => $object->type,
|
|
|
63 message => $object->Message,
|
|
|
64 arguments => $this->Transform(scalar $object->Args)
|
|
|
65 };
|
|
|
66 },
|
|
|
67 -plain => sub {
|
|
|
68 $_[1];
|
|
|
69 },
|
|
|
70 -default => sub {
|
|
|
71 my ($this,$object) = @_;
|
|
|
72
|
|
|
73 return "$object" unless $object->isa('IMPL::Object::Abstract');
|
|
|
74
|
|
|
75 my $propList = $propListCache{ref $object};
|
|
|
76 unless ( $propList ) {
|
|
|
77 my %props = map {
|
|
|
78 $_->Name, (ref $_->Mutators ? 0 : ($_->Mutators & prop_list))
|
|
|
79 } $object->get_meta('IMPL::Class::PropertyInfo',sub { $_->Access == IMPL::Class::Member::MOD_PUBLIC and $_->Name !~ /^_/}, 1 );
|
|
118
|
80
|
|
119
|
81 $propListCache{ref $object} = $propList = \%props;
|
|
118
|
82 }
|
|
|
83
|
|
|
84 return {
|
|
|
85 map {
|
|
119
|
86 $_, $propList->{$_} ? $this->Transform([$object->$_()]) : $this->Transform(scalar $object->$_());
|
|
|
87 } keys %$propList
|
|
118
|
88 };
|
|
|
89 }
|
|
|
90 }
|
|
|
91 );
|
|
|
92
|
|
119
|
93 1; |
