# HG changeset patch # User wizard # Date 1275918314 -14400 # Node ID 41e9d9ea3db555b5851287ec28cf1798f98f0446 # Parent 8114aaa7febadce511dbacc8addbfb8d787bcbd2# Parent 79cdd6c86409806bd1de092d9f0fb2b048775720 Merge with 79cdd6c86409806bd1de092d9f0fb2b048775720 diff -r 79cdd6c86409 -r 41e9d9ea3db5 Lib/IMPL/Web/QueryHandler/JsonFormat.pm --- a/Lib/IMPL/Web/QueryHandler/JsonFormat.pm Mon Jun 07 08:21:26 2010 +0400 +++ b/Lib/IMPL/Web/QueryHandler/JsonFormat.pm Mon Jun 07 17:45:14 2010 +0400 @@ -1,80 +1,93 @@ -package IMPL::Web::QueryHandler::JsonTransform; +use strict; +package IMPL::Transform::Json; + package IMPL::Web::QueryHandler::JsonFormat; -use strict; use base qw(IMPL::Web::QueryHandler); - -__PACKAGE__->PassThroughArgs; - use Error qw(:try); use JSON; sub Process { my ($this,$action,$nextHandler) = @_; - my $transform = new IMPL::Web::QueryHandler::JsonTransform(); + my $result; + my $t = new IMPL::Transform::Json; - my $result; 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($result, {pretty => 1} ); -} + print $hout to_json( $t->Transform($result), {pretty => 1} ); +} -package IMPL::Web::QueryHandler::JsonTransform; +package IMPL::Transform::Json; use base qw(IMPL::Transform); use IMPL::Class::Property; - -BEGIN { - public property cacheClassProps => prop_all; -} +my %propListCache; our %CTOR = ( 'IMPL::Transform' => sub { - - -plain => sub { $_[1]; }, # keep plains as is - - HASH => sub { $_[1]; }, # keep arrays as is - - 'IMPL::Object::List' => sub { [$_[1]->as_list()] }, # make a copy - - -default => sub { # convert to hash + 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 + ]; + }, + 'IMPL::Exception' => sub { my ($this,$object) = @_; - - my $propList = $this->cacheClassProps->{ref $object}; - unless ($propList) { - # derived first, then own properties, only public - my %props = map { $_->name, $_ } $this->get_meta( 'IMPL::Class::PropertyInfo', sub { $_->Access == IMPL::Class::Member::MOD_PUBLIC } , 1 ); - $this->cacheClassProps->{ref $object} = $propList = [keys %props]; + + return { + type => $object->type, + message => $object->Message, + arguments => $this->Transform(scalar $object->Args) + }; + }, + -plain => sub { + $_[1]; + }, + -default => sub { + my ($this,$object) = @_; + + return "$object" unless $object->isa('IMPL::Object::Abstract'); + + 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 { - $_, - $this->Transform($object->$_()) - } @$propList + $_, $propList->{$_} ? $this->Transform([$object->$_()]) : $this->Transform(scalar $object->$_()); + } keys %$propList }; } } ); -sub CTOR { - my ($this) = @_; - - $this->cacheClassProps({}); -} - -1; - -__END__ - -=pod - -=cut \ No newline at end of file +1; \ No newline at end of file