|
119
|
1 use strict;
|
|
|
2 package IMPL::Transform::Json;
|
|
|
3
|
|
118
|
4 package IMPL::Web::QueryHandler::JsonFormat;
|
|
166
|
5 use parent qw(IMPL::Web::QueryHandler);
|
|
118
|
6 use Error qw(:try);
|
|
|
7 use JSON;
|
|
|
8
|
|
|
9 sub Process {
|
|
194
|
10 my ($this,$action,$nextHandler) = @_;
|
|
|
11
|
|
|
12 my $result;
|
|
|
13
|
|
|
14 try {
|
|
|
15 $result = $nextHandler->();
|
|
|
16 $result = [$result] unless ref $result;
|
|
|
17 } otherwise {
|
|
|
18 my $err = shift;
|
|
|
19 $result = { error => $err };
|
|
|
20 };
|
|
|
21
|
|
|
22 my $t = new IMPL::Transform::Json($action->context->{json});
|
|
|
23
|
|
|
24 if ($action->context->{transactionType} and $action->context->{transactionType} eq 'form') {
|
|
|
25 delete @$result{qw(formData formSchema)};
|
|
|
26 my $errors = @$result{formErrors};
|
|
|
27
|
|
|
28 $result->{formErrors} = [ map $_->Message, @$errors ] if $errors;
|
|
|
29 }
|
|
|
30
|
|
|
31 $action->response->contentType('text/javascript');
|
|
|
32
|
|
|
33 my $hout = $action->response->streamBody;
|
|
|
34 print $hout to_json( $t->Transform($result), {pretty => 1} );
|
|
119
|
35 }
|
|
118
|
36
|
|
119
|
37 package IMPL::Transform::Json;
|
|
118
|
38
|
|
166
|
39 use parent qw(IMPL::Transform);
|
|
118
|
40 use IMPL::Class::Property;
|
|
134
|
41 use IMPL::Class::Property::Direct;
|
|
|
42 use Scalar::Util qw(refaddr);
|
|
|
43
|
|
|
44 BEGIN {
|
|
194
|
45 private _direct property _visited => prop_none;
|
|
134
|
46 }
|
|
|
47
|
|
119
|
48 my %propListCache;
|
|
118
|
49
|
|
|
50 our %CTOR = (
|
|
194
|
51 'IMPL::Transform' => sub {
|
|
|
52 my $options = shift;
|
|
|
53 (
|
|
|
54 $options ? %{$options} : ()
|
|
|
55 ),
|
|
|
56 ARRAY => sub {
|
|
|
57 my ($this,$object) = @_;
|
|
|
58
|
|
|
59 return [
|
|
|
60 map { $this->Transform($_) } @$object
|
|
|
61 ];
|
|
|
62 },
|
|
|
63 HASH => sub {
|
|
|
64 my ($this,$object) = @_;
|
|
|
65
|
|
|
66 return {
|
|
|
67 map { $_, $this->Transform($object->{$_}) } keys %$object
|
|
|
68 };
|
|
|
69 },
|
|
|
70 'IMPL::Object::List' => sub {
|
|
|
71 my ($this,$object) = @_;
|
|
|
72
|
|
|
73 return [
|
|
|
74 map { $this->Transform($_) } @$object
|
|
|
75 ];
|
|
|
76 },
|
|
|
77 -plain => sub {
|
|
|
78 $_[1];
|
|
|
79 },
|
|
|
80 -default => sub {
|
|
|
81 my ($this,$object) = @_;
|
|
|
82
|
|
|
83 return "$object" unless $object->isa('IMPL::Object::Abstract');
|
|
|
84
|
|
|
85 if ( $object->isa(typeof IMPL::Exception) ) {
|
|
|
86 return {
|
|
|
87 type => $object->typeof,
|
|
|
88 message => $object->Message,
|
|
|
89 arguments => $this->Transform(scalar $object->Args)
|
|
|
90 };
|
|
|
91 }
|
|
|
92
|
|
|
93 my $propList = $propListCache{ref $object};
|
|
|
94 unless ( $propList ) {
|
|
|
95 my %props = map {
|
|
|
96 $_->Name, (ref $_->Mutators ? 0 : ($_->Mutators & prop_list))
|
|
|
97 } $object->get_meta('IMPL::Class::PropertyInfo',sub { $_->Access == IMPL::Class::Member::MOD_PUBLIC and $_->Name !~ /^_/}, 1 );
|
|
|
98
|
|
|
99 $propListCache{ref $object} = $propList = \%props;
|
|
|
100 }
|
|
|
101
|
|
|
102 return {
|
|
|
103 map {
|
|
|
104 $_, $propList->{$_} ? $this->Transform([$object->$_()]) : $this->Transform(scalar $object->$_());
|
|
|
105 } keys %$propList
|
|
|
106 };
|
|
|
107 }
|
|
|
108 }
|
|
118
|
109 );
|
|
|
110
|
|
134
|
111 sub Transform {
|
|
194
|
112 my ($this,$object) = @_;
|
|
|
113
|
|
|
114 # small hack to prevent cycling
|
|
|
115
|
|
|
116 return $this->SUPER::Transform($object) unless ref $object;
|
|
|
117
|
|
|
118 if (exists $this->{$_visited}{refaddr $object}) {
|
|
|
119 return $this->{$_visited}{refaddr $object};
|
|
|
120 } else {
|
|
|
121 $this->{$_visited}{refaddr $object} = undef;
|
|
|
122 return $this->{$_visited}{refaddr $object} = $this->SUPER::Transform($object);
|
|
|
123 }
|
|
134
|
124 }
|
|
|
125
|
|
180
|
126 1;
|
