diff Lib/IMPL/Web/QueryHandler/JsonFormat.pm @ 119:8114aaa7feba

Json format
author wizard
date Mon, 07 Jun 2010 17:43:15 +0400
parents
children 41e9d9ea3db5
line wrap: on
line diff
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/Lib/IMPL/Web/QueryHandler/JsonFormat.pm	Mon Jun 07 17:43:15 2010 +0400
@@ -0,0 +1,93 @@
+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;
\ No newline at end of file