Mercurial > pub > Impl
annotate Lib/IMPL/Web/QueryHandler/JsonFormat.pm @ 130:06a34c197b05
Added support for utf-8 and old versions of CGI module
| author | wizard |
|---|---|
| date | Wed, 16 Jun 2010 01:50:56 +0400 |
| parents | 08753833173d |
| children | 44977efed303 |
| rev | line source |
|---|---|
| 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 -plain => sub { | |
| 59 $_[1]; | |
| 60 }, | |
| 61 -default => sub { | |
| 62 my ($this,$object) = @_; | |
| 63 | |
| 64 return "$object" unless $object->isa('IMPL::Object::Abstract'); | |
| 65 | |
|
128
08753833173d
Fixed a error handling issue in JSON output: errors are correctly transfered
wizard
parents:
120
diff
changeset
|
66 if ( $object->isa(typeof IMPL::Exception) ) { |
|
08753833173d
Fixed a error handling issue in JSON output: errors are correctly transfered
wizard
parents:
120
diff
changeset
|
67 return { |
|
08753833173d
Fixed a error handling issue in JSON output: errors are correctly transfered
wizard
parents:
120
diff
changeset
|
68 type => $object->typeof, |
|
08753833173d
Fixed a error handling issue in JSON output: errors are correctly transfered
wizard
parents:
120
diff
changeset
|
69 message => $object->Message, |
|
08753833173d
Fixed a error handling issue in JSON output: errors are correctly transfered
wizard
parents:
120
diff
changeset
|
70 arguments => $this->Transform(scalar $object->Args) |
|
08753833173d
Fixed a error handling issue in JSON output: errors are correctly transfered
wizard
parents:
120
diff
changeset
|
71 }; |
|
08753833173d
Fixed a error handling issue in JSON output: errors are correctly transfered
wizard
parents:
120
diff
changeset
|
72 } |
|
08753833173d
Fixed a error handling issue in JSON output: errors are correctly transfered
wizard
parents:
120
diff
changeset
|
73 |
| 119 | 74 my $propList = $propListCache{ref $object}; |
| 75 unless ( $propList ) { | |
| 76 my %props = map { | |
| 77 $_->Name, (ref $_->Mutators ? 0 : ($_->Mutators & prop_list)) | |
| 78 } $object->get_meta('IMPL::Class::PropertyInfo',sub { $_->Access == IMPL::Class::Member::MOD_PUBLIC and $_->Name !~ /^_/}, 1 ); | |
| 118 | 79 |
| 119 | 80 $propListCache{ref $object} = $propList = \%props; |
| 118 | 81 } |
| 82 | |
| 83 return { | |
| 84 map { | |
| 119 | 85 $_, $propList->{$_} ? $this->Transform([$object->$_()]) : $this->Transform(scalar $object->$_()); |
| 86 } keys %$propList | |
| 118 | 87 }; |
| 88 } | |
| 89 } | |
| 90 ); | |
| 91 | |
| 119 | 92 1; |