Mercurial > pub > Impl
comparison Lib/IMPL/Web/QueryHandler/JsonFormat.pm @ 119:8114aaa7feba
Json format
author | wizard |
---|---|
date | Mon, 07 Jun 2010 17:43:15 +0400 |
parents | |
children | 41e9d9ea3db5 |
comparison
equal
deleted
inserted
replaced
117:0475eb382085 | 119:8114aaa7feba |
---|---|
1 use strict; | |
2 package IMPL::Transform::Json; | |
3 | |
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 | |
12 my $result; | |
13 my $t = new IMPL::Transform::Json; | |
14 | |
15 try { | |
16 $result = $nextHandler->(); | |
17 $result = [$result] unless ref $result; | |
18 } otherwise { | |
19 my $err = shift; | |
20 $result = { error => $err }; | |
21 }; | |
22 | |
23 $action->response->contentType('text/javascript'); | |
24 | |
25 my $hout = $action->response->streamBody; | |
26 print $hout to_json( $t->Transform($result), {pretty => 1} ); | |
27 } | |
28 | |
29 package IMPL::Transform::Json; | |
30 | |
31 use base qw(IMPL::Transform); | |
32 use IMPL::Class::Property; | |
33 my %propListCache; | |
34 | |
35 our %CTOR = ( | |
36 'IMPL::Transform' => sub { | |
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 { | |
59 my ($this,$object) = @_; | |
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 ); | |
80 | |
81 $propListCache{ref $object} = $propList = \%props; | |
82 } | |
83 | |
84 return { | |
85 map { | |
86 $_, $propList->{$_} ? $this->Transform([$object->$_()]) : $this->Transform(scalar $object->$_()); | |
87 } keys %$propList | |
88 }; | |
89 } | |
90 } | |
91 ); | |
92 | |
93 1; |