Mercurial > pub > Impl

comparison Lib/IMPL/Web/QueryHandler/JsonFormat.pm @ 194:4d0e1962161c

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