Mercurial > pub > Impl
annotate Lib/IMPL/Web/QueryHandler/JsonFormat.pm @ 186:6c0fee769b0c
IMPL::Web::View::TTControl tests, fixes
| author | cin |
|---|---|
| date | Fri, 30 Mar 2012 16:40:34 +0400 |
| parents | d1676be8afcc |
| children | 4d0e1962161c |
| rev | line source |
|---|---|
| 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 { | |
| 10 my ($this,$action,$nextHandler) = @_; | |
| 11 | |
| 119 | 12 my $result; |
| 118 | 13 |
| 14 try { | |
| 15 $result = $nextHandler->(); | |
| 119 | 16 $result = [$result] unless ref $result; |
| 118 | 17 } otherwise { |
| 18 my $err = shift; | |
| 19 $result = { error => $err }; | |
| 20 }; | |
| 21 | |
| 173 | 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 | |
| 118 | 31 $action->response->contentType('text/javascript'); |
| 119 | 32 |
| 118 | 33 my $hout = $action->response->streamBody; |
| 119 | 34 print $hout to_json( $t->Transform($result), {pretty => 1} ); |
| 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 { | |
| 45 private _direct property _visited => prop_none; | |
| 46 } | |
| 47 | |
| 119 | 48 my %propListCache; |
| 118 | 49 |
| 50 our %CTOR = ( | |
| 51 'IMPL::Transform' => sub { | |
| 173 | 52 my $options = shift; |
| 53 ( | |
| 54 $options ? %{$options} : () | |
| 55 ), | |
| 119 | 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 | |
|
128
08753833173d
Fixed a error handling issue in JSON output: errors are correctly transfered
wizard
parents:
120
diff
changeset
|
85 if ( $object->isa(typeof IMPL::Exception) ) { |
|
08753833173d
Fixed a error handling issue in JSON output: errors are correctly transfered
wizard
parents:
120
diff
changeset
|
86 return { |
|
08753833173d
Fixed a error handling issue in JSON output: errors are correctly transfered
wizard
parents:
120
diff
changeset
|
87 type => $object->typeof, |
|
08753833173d
Fixed a error handling issue in JSON output: errors are correctly transfered
wizard
parents:
120
diff
changeset
|
88 message => $object->Message, |
|
08753833173d
Fixed a error handling issue in JSON output: errors are correctly transfered
wizard
parents:
120
diff
changeset
|
89 arguments => $this->Transform(scalar $object->Args) |
|
08753833173d
Fixed a error handling issue in JSON output: errors are correctly transfered
wizard
parents:
120
diff
changeset
|
90 }; |
|
08753833173d
Fixed a error handling issue in JSON output: errors are correctly transfered
wizard
parents:
120
diff
changeset
|
91 } |
|
08753833173d
Fixed a error handling issue in JSON output: errors are correctly transfered
wizard
parents:
120
diff
changeset
|
92 |
| 119 | 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 ); | |
| 118 | 98 |
| 119 | 99 $propListCache{ref $object} = $propList = \%props; |
| 118 | 100 } |
| 101 | |
| 102 return { | |
| 103 map { | |
| 119 | 104 $_, $propList->{$_} ? $this->Transform([$object->$_()]) : $this->Transform(scalar $object->$_()); |
| 105 } keys %$propList | |
| 118 | 106 }; |
| 107 } | |
| 108 } | |
| 109 ); | |
| 110 | |
| 134 | 111 sub Transform { |
| 112 my ($this,$object) = @_; | |
| 113 | |
|
140
fb896377389f
to_json and escape_string functions for the templates
wizard
parents:
134
diff
changeset
|
114 # small hack to prevent cycling |
|
fb896377389f
to_json and escape_string functions for the templates
wizard
parents:
134
diff
changeset
|
115 |
| 134 | 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 } | |
| 124 } | |
| 125 | |
| 180 | 126 1; |