changeset 120:41e9d9ea3db5

Merge with 79cdd6c86409806bd1de092d9f0fb2b048775720
author wizard
date Mon, 07 Jun 2010 17:45:14 +0400
parents 8114aaa7feba (diff) 79cdd6c86409 (current diff)
children 92c850d0bdb9
files Lib/IMPL/Web/QueryHandler/JsonFormat.pm
diffstat 1 files changed, 57 insertions(+), 44 deletions(-) [+]
line wrap: on
line diff
--- 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