view Lib/IMPL/Web/QueryHandler/JsonFormat.pm @ 121:92c850d0bdb9

Minor changes Fixed bug with templates base in the PageFormat module Added an ability to remove current security context with a specified
author wizard
date Tue, 08 Jun 2010 03:38:10 +0400
parents 41e9d9ea3db5
children 08753833173d
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
			]; 
		},
		'IMPL::Exception' => sub {
			my ($this,$object) = @_;
			
			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 {
					$_, $propList->{$_} ? $this->Transform([$object->$_()]) : $this->Transform(scalar $object->$_());
				} keys %$propList
			};
		}
	}
);

1;