annotate Lib/IMPL/Web/QueryHandler/JsonFormat.pm @ 166:4267a2ac3d46

Added Class::Template, Rewritten SQL::Schema 'use parent' directive instead of 'use base'
author wizard
date Sat, 23 Apr 2011 23:12:06 +0400
parents fb896377389f
children aaab45153411
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
119
8114aaa7feba Json format
wizard
parents:
diff changeset
1 use strict;
8114aaa7feba Json format
wizard
parents:
diff changeset
2 package IMPL::Transform::Json;
8114aaa7feba Json format
wizard
parents:
diff changeset
3
118
79cdd6c86409 JSON support (experimental)
wizard
parents:
diff changeset
4 package IMPL::Web::QueryHandler::JsonFormat;
166
4267a2ac3d46 Added Class::Template,
wizard
parents: 140
diff changeset
5 use parent qw(IMPL::Web::QueryHandler);
118
79cdd6c86409 JSON support (experimental)
wizard
parents:
diff changeset
6 use Error qw(:try);
79cdd6c86409 JSON support (experimental)
wizard
parents:
diff changeset
7 use JSON;
79cdd6c86409 JSON support (experimental)
wizard
parents:
diff changeset
8
79cdd6c86409 JSON support (experimental)
wizard
parents:
diff changeset
9 sub Process {
79cdd6c86409 JSON support (experimental)
wizard
parents:
diff changeset
10 my ($this,$action,$nextHandler) = @_;
79cdd6c86409 JSON support (experimental)
wizard
parents:
diff changeset
11
119
8114aaa7feba Json format
wizard
parents:
diff changeset
12 my $result;
8114aaa7feba Json format
wizard
parents:
diff changeset
13 my $t = new IMPL::Transform::Json;
118
79cdd6c86409 JSON support (experimental)
wizard
parents:
diff changeset
14
79cdd6c86409 JSON support (experimental)
wizard
parents:
diff changeset
15 try {
79cdd6c86409 JSON support (experimental)
wizard
parents:
diff changeset
16 $result = $nextHandler->();
119
8114aaa7feba Json format
wizard
parents:
diff changeset
17 $result = [$result] unless ref $result;
118
79cdd6c86409 JSON support (experimental)
wizard
parents:
diff changeset
18 } otherwise {
79cdd6c86409 JSON support (experimental)
wizard
parents:
diff changeset
19 my $err = shift;
79cdd6c86409 JSON support (experimental)
wizard
parents:
diff changeset
20 $result = { error => $err };
79cdd6c86409 JSON support (experimental)
wizard
parents:
diff changeset
21 };
79cdd6c86409 JSON support (experimental)
wizard
parents:
diff changeset
22
79cdd6c86409 JSON support (experimental)
wizard
parents:
diff changeset
23 $action->response->contentType('text/javascript');
119
8114aaa7feba Json format
wizard
parents:
diff changeset
24
118
79cdd6c86409 JSON support (experimental)
wizard
parents:
diff changeset
25 my $hout = $action->response->streamBody;
119
8114aaa7feba Json format
wizard
parents:
diff changeset
26 print $hout to_json( $t->Transform($result), {pretty => 1} );
8114aaa7feba Json format
wizard
parents:
diff changeset
27 }
118
79cdd6c86409 JSON support (experimental)
wizard
parents:
diff changeset
28
119
8114aaa7feba Json format
wizard
parents:
diff changeset
29 package IMPL::Transform::Json;
118
79cdd6c86409 JSON support (experimental)
wizard
parents:
diff changeset
30
166
4267a2ac3d46 Added Class::Template,
wizard
parents: 140
diff changeset
31 use parent qw(IMPL::Transform);
118
79cdd6c86409 JSON support (experimental)
wizard
parents:
diff changeset
32 use IMPL::Class::Property;
134
44977efed303 Significant performance optimizations
wizard
parents: 128
diff changeset
33 use IMPL::Class::Property::Direct;
44977efed303 Significant performance optimizations
wizard
parents: 128
diff changeset
34 use Scalar::Util qw(refaddr);
44977efed303 Significant performance optimizations
wizard
parents: 128
diff changeset
35
44977efed303 Significant performance optimizations
wizard
parents: 128
diff changeset
36 BEGIN {
44977efed303 Significant performance optimizations
wizard
parents: 128
diff changeset
37 private _direct property _visited => prop_none;
44977efed303 Significant performance optimizations
wizard
parents: 128
diff changeset
38 }
44977efed303 Significant performance optimizations
wizard
parents: 128
diff changeset
39
119
8114aaa7feba Json format
wizard
parents:
diff changeset
40 my %propListCache;
118
79cdd6c86409 JSON support (experimental)
wizard
parents:
diff changeset
41
79cdd6c86409 JSON support (experimental)
wizard
parents:
diff changeset
42 our %CTOR = (
79cdd6c86409 JSON support (experimental)
wizard
parents:
diff changeset
43 'IMPL::Transform' => sub {
119
8114aaa7feba Json format
wizard
parents:
diff changeset
44 ARRAY => sub {
8114aaa7feba Json format
wizard
parents:
diff changeset
45 my ($this,$object) = @_;
8114aaa7feba Json format
wizard
parents:
diff changeset
46
8114aaa7feba Json format
wizard
parents:
diff changeset
47 return [
8114aaa7feba Json format
wizard
parents:
diff changeset
48 map { $this->Transform($_) } @$object
8114aaa7feba Json format
wizard
parents:
diff changeset
49 ];
8114aaa7feba Json format
wizard
parents:
diff changeset
50 },
8114aaa7feba Json format
wizard
parents:
diff changeset
51 HASH => sub {
8114aaa7feba Json format
wizard
parents:
diff changeset
52 my ($this,$object) = @_;
8114aaa7feba Json format
wizard
parents:
diff changeset
53
8114aaa7feba Json format
wizard
parents:
diff changeset
54 return {
8114aaa7feba Json format
wizard
parents:
diff changeset
55 map { $_, $this->Transform($object->{$_}) } keys %$object
8114aaa7feba Json format
wizard
parents:
diff changeset
56 };
8114aaa7feba Json format
wizard
parents:
diff changeset
57 },
8114aaa7feba Json format
wizard
parents:
diff changeset
58 'IMPL::Object::List' => sub {
8114aaa7feba Json format
wizard
parents:
diff changeset
59 my ($this,$object) = @_;
8114aaa7feba Json format
wizard
parents:
diff changeset
60
8114aaa7feba Json format
wizard
parents:
diff changeset
61 return [
8114aaa7feba Json format
wizard
parents:
diff changeset
62 map { $this->Transform($_) } @$object
8114aaa7feba Json format
wizard
parents:
diff changeset
63 ];
8114aaa7feba Json format
wizard
parents:
diff changeset
64 },
8114aaa7feba Json format
wizard
parents:
diff changeset
65 -plain => sub {
8114aaa7feba Json format
wizard
parents:
diff changeset
66 $_[1];
8114aaa7feba Json format
wizard
parents:
diff changeset
67 },
8114aaa7feba Json format
wizard
parents:
diff changeset
68 -default => sub {
8114aaa7feba Json format
wizard
parents:
diff changeset
69 my ($this,$object) = @_;
8114aaa7feba Json format
wizard
parents:
diff changeset
70
8114aaa7feba Json format
wizard
parents:
diff changeset
71 return "$object" unless $object->isa('IMPL::Object::Abstract');
8114aaa7feba Json format
wizard
parents:
diff changeset
72
128
08753833173d Fixed a error handling issue in JSON output: errors are correctly transfered
wizard
parents: 120
diff changeset
73 if ( $object->isa(typeof IMPL::Exception) ) {
08753833173d Fixed a error handling issue in JSON output: errors are correctly transfered
wizard
parents: 120
diff changeset
74 return {
08753833173d Fixed a error handling issue in JSON output: errors are correctly transfered
wizard
parents: 120
diff changeset
75 type => $object->typeof,
08753833173d Fixed a error handling issue in JSON output: errors are correctly transfered
wizard
parents: 120
diff changeset
76 message => $object->Message,
08753833173d Fixed a error handling issue in JSON output: errors are correctly transfered
wizard
parents: 120
diff changeset
77 arguments => $this->Transform(scalar $object->Args)
08753833173d Fixed a error handling issue in JSON output: errors are correctly transfered
wizard
parents: 120
diff changeset
78 };
08753833173d Fixed a error handling issue in JSON output: errors are correctly transfered
wizard
parents: 120
diff changeset
79 }
08753833173d Fixed a error handling issue in JSON output: errors are correctly transfered
wizard
parents: 120
diff changeset
80
119
8114aaa7feba Json format
wizard
parents:
diff changeset
81 my $propList = $propListCache{ref $object};
8114aaa7feba Json format
wizard
parents:
diff changeset
82 unless ( $propList ) {
8114aaa7feba Json format
wizard
parents:
diff changeset
83 my %props = map {
8114aaa7feba Json format
wizard
parents:
diff changeset
84 $_->Name, (ref $_->Mutators ? 0 : ($_->Mutators & prop_list))
8114aaa7feba Json format
wizard
parents:
diff changeset
85 } $object->get_meta('IMPL::Class::PropertyInfo',sub { $_->Access == IMPL::Class::Member::MOD_PUBLIC and $_->Name !~ /^_/}, 1 );
118
79cdd6c86409 JSON support (experimental)
wizard
parents:
diff changeset
86
119
8114aaa7feba Json format
wizard
parents:
diff changeset
87 $propListCache{ref $object} = $propList = \%props;
118
79cdd6c86409 JSON support (experimental)
wizard
parents:
diff changeset
88 }
79cdd6c86409 JSON support (experimental)
wizard
parents:
diff changeset
89
79cdd6c86409 JSON support (experimental)
wizard
parents:
diff changeset
90 return {
79cdd6c86409 JSON support (experimental)
wizard
parents:
diff changeset
91 map {
119
8114aaa7feba Json format
wizard
parents:
diff changeset
92 $_, $propList->{$_} ? $this->Transform([$object->$_()]) : $this->Transform(scalar $object->$_());
8114aaa7feba Json format
wizard
parents:
diff changeset
93 } keys %$propList
118
79cdd6c86409 JSON support (experimental)
wizard
parents:
diff changeset
94 };
79cdd6c86409 JSON support (experimental)
wizard
parents:
diff changeset
95 }
79cdd6c86409 JSON support (experimental)
wizard
parents:
diff changeset
96 }
79cdd6c86409 JSON support (experimental)
wizard
parents:
diff changeset
97 );
79cdd6c86409 JSON support (experimental)
wizard
parents:
diff changeset
98
134
44977efed303 Significant performance optimizations
wizard
parents: 128
diff changeset
99 sub Transform {
44977efed303 Significant performance optimizations
wizard
parents: 128
diff changeset
100 my ($this,$object) = @_;
44977efed303 Significant performance optimizations
wizard
parents: 128
diff changeset
101
140
fb896377389f to_json and escape_string functions for the templates
wizard
parents: 134
diff changeset
102 # small hack to prevent cycling
fb896377389f to_json and escape_string functions for the templates
wizard
parents: 134
diff changeset
103
134
44977efed303 Significant performance optimizations
wizard
parents: 128
diff changeset
104 return $this->SUPER::Transform($object) unless ref $object;
44977efed303 Significant performance optimizations
wizard
parents: 128
diff changeset
105
44977efed303 Significant performance optimizations
wizard
parents: 128
diff changeset
106 if (exists $this->{$_visited}{refaddr $object}) {
44977efed303 Significant performance optimizations
wizard
parents: 128
diff changeset
107 return $this->{$_visited}{refaddr $object};
44977efed303 Significant performance optimizations
wizard
parents: 128
diff changeset
108 } else {
44977efed303 Significant performance optimizations
wizard
parents: 128
diff changeset
109 $this->{$_visited}{refaddr $object} = undef;
44977efed303 Significant performance optimizations
wizard
parents: 128
diff changeset
110 return $this->{$_visited}{refaddr $object} = $this->SUPER::Transform($object);
44977efed303 Significant performance optimizations
wizard
parents: 128
diff changeset
111 }
44977efed303 Significant performance optimizations
wizard
parents: 128
diff changeset
112 }
44977efed303 Significant performance optimizations
wizard
parents: 128
diff changeset
113
119
8114aaa7feba Json format
wizard
parents:
diff changeset
114 1;