Mercurial > pub > Impl
view 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 |
line wrap: on
line source
use strict; package IMPL::Transform::Json; package IMPL::Web::QueryHandler::JsonFormat; use base qw(IMPL::Web::QueryHandler); use Error qw(:try); use JSON; sub Process { my ($this,$action,$nextHandler) = @_; my $result; my $t = new IMPL::Transform::Json; try { $result = $nextHandler->(); $result = [$result] unless ref $result; } otherwise { my $err = shift; $result = { error => $err }; }; $action->response->contentType('text/javascript'); my $hout = $action->response->streamBody; print $hout to_json( $t->Transform($result), {pretty => 1} ); } package IMPL::Transform::Json; use base qw(IMPL::Transform); use IMPL::Class::Property; my %propListCache; our %CTOR = ( 'IMPL::Transform' => sub { ARRAY => sub { my ($this,$object) = @_; return [ map { $this->Transform($_) } @$object ]; }, HASH => sub { my ($this,$object) = @_; return { map { $_, $this->Transform($object->{$_}) } keys %$object }; }, 'IMPL::Object::List' => sub { my ($this,$object) = @_; return [ map { $this->Transform($_) } @$object ]; }, -plain => sub { $_[1]; }, -default => sub { my ($this,$object) = @_; return "$object" unless $object->isa('IMPL::Object::Abstract'); if ( $object->isa(typeof IMPL::Exception) ) { return { type => $object->typeof, message => $object->Message, arguments => $this->Transform(scalar $object->Args) }; } my $propList = $propListCache{ref $object}; unless ( $propList ) { my %props = map { $_->Name, (ref $_->Mutators ? 0 : ($_->Mutators & prop_list)) } $object->get_meta('IMPL::Class::PropertyInfo',sub { $_->Access == IMPL::Class::Member::MOD_PUBLIC and $_->Name !~ /^_/}, 1 ); $propListCache{ref $object} = $propList = \%props; } return { map { $_, $propList->{$_} ? $this->Transform([$object->$_()]) : $this->Transform(scalar $object->$_()); } keys %$propList }; } } ); 1;