annotate Lib/IMPL/Web/QueryHandler/JsonFormat.pm @ 118:79cdd6c86409

JSON support (experimental)
author wizard
date Mon, 07 Jun 2010 08:21:26 +0400
parents
children 41e9d9ea3db5
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
118
79cdd6c86409 JSON support (experimental)
wizard
parents:
diff changeset
1 package IMPL::Web::QueryHandler::JsonTransform;
79cdd6c86409 JSON support (experimental)
wizard
parents:
diff changeset
2 package IMPL::Web::QueryHandler::JsonFormat;
79cdd6c86409 JSON support (experimental)
wizard
parents:
diff changeset
3 use strict;
79cdd6c86409 JSON support (experimental)
wizard
parents:
diff changeset
4 use base qw(IMPL::Web::QueryHandler);
79cdd6c86409 JSON support (experimental)
wizard
parents:
diff changeset
5
79cdd6c86409 JSON support (experimental)
wizard
parents:
diff changeset
6 __PACKAGE__->PassThroughArgs;
79cdd6c86409 JSON support (experimental)
wizard
parents:
diff changeset
7
79cdd6c86409 JSON support (experimental)
wizard
parents:
diff changeset
8 use Error qw(:try);
79cdd6c86409 JSON support (experimental)
wizard
parents:
diff changeset
9 use JSON;
79cdd6c86409 JSON support (experimental)
wizard
parents:
diff changeset
10
79cdd6c86409 JSON support (experimental)
wizard
parents:
diff changeset
11 sub Process {
79cdd6c86409 JSON support (experimental)
wizard
parents:
diff changeset
12 my ($this,$action,$nextHandler) = @_;
79cdd6c86409 JSON support (experimental)
wizard
parents:
diff changeset
13
79cdd6c86409 JSON support (experimental)
wizard
parents:
diff changeset
14 my $transform = new IMPL::Web::QueryHandler::JsonTransform();
79cdd6c86409 JSON support (experimental)
wizard
parents:
diff changeset
15
79cdd6c86409 JSON support (experimental)
wizard
parents:
diff changeset
16 my $result;
79cdd6c86409 JSON support (experimental)
wizard
parents:
diff changeset
17 try {
79cdd6c86409 JSON support (experimental)
wizard
parents:
diff changeset
18 $result = $nextHandler->();
79cdd6c86409 JSON support (experimental)
wizard
parents:
diff changeset
19 } otherwise {
79cdd6c86409 JSON support (experimental)
wizard
parents:
diff changeset
20 my $err = shift;
79cdd6c86409 JSON support (experimental)
wizard
parents:
diff changeset
21 $result = { error => $err };
79cdd6c86409 JSON support (experimental)
wizard
parents:
diff changeset
22 };
79cdd6c86409 JSON support (experimental)
wizard
parents:
diff changeset
23
79cdd6c86409 JSON support (experimental)
wizard
parents:
diff changeset
24 $action->response->contentType('text/javascript');
79cdd6c86409 JSON support (experimental)
wizard
parents:
diff changeset
25 my $hout = $action->response->streamBody;
79cdd6c86409 JSON support (experimental)
wizard
parents:
diff changeset
26 print $hout to_json($result, {pretty => 1} );
79cdd6c86409 JSON support (experimental)
wizard
parents:
diff changeset
27 }
79cdd6c86409 JSON support (experimental)
wizard
parents:
diff changeset
28
79cdd6c86409 JSON support (experimental)
wizard
parents:
diff changeset
29 package IMPL::Web::QueryHandler::JsonTransform;
79cdd6c86409 JSON support (experimental)
wizard
parents:
diff changeset
30
79cdd6c86409 JSON support (experimental)
wizard
parents:
diff changeset
31 use base qw(IMPL::Transform);
79cdd6c86409 JSON support (experimental)
wizard
parents:
diff changeset
32 use IMPL::Class::Property;
79cdd6c86409 JSON support (experimental)
wizard
parents:
diff changeset
33
79cdd6c86409 JSON support (experimental)
wizard
parents:
diff changeset
34 BEGIN {
79cdd6c86409 JSON support (experimental)
wizard
parents:
diff changeset
35 public property cacheClassProps => prop_all;
79cdd6c86409 JSON support (experimental)
wizard
parents:
diff changeset
36 }
79cdd6c86409 JSON support (experimental)
wizard
parents:
diff changeset
37
79cdd6c86409 JSON support (experimental)
wizard
parents:
diff changeset
38 our %CTOR = (
79cdd6c86409 JSON support (experimental)
wizard
parents:
diff changeset
39 'IMPL::Transform' => sub {
79cdd6c86409 JSON support (experimental)
wizard
parents:
diff changeset
40
79cdd6c86409 JSON support (experimental)
wizard
parents:
diff changeset
41 -plain => sub { $_[1]; }, # keep plains as is
79cdd6c86409 JSON support (experimental)
wizard
parents:
diff changeset
42
79cdd6c86409 JSON support (experimental)
wizard
parents:
diff changeset
43 HASH => sub { $_[1]; }, # keep arrays as is
79cdd6c86409 JSON support (experimental)
wizard
parents:
diff changeset
44
79cdd6c86409 JSON support (experimental)
wizard
parents:
diff changeset
45 'IMPL::Object::List' => sub { [$_[1]->as_list()] }, # make a copy
79cdd6c86409 JSON support (experimental)
wizard
parents:
diff changeset
46
79cdd6c86409 JSON support (experimental)
wizard
parents:
diff changeset
47 -default => sub { # convert to hash
79cdd6c86409 JSON support (experimental)
wizard
parents:
diff changeset
48 my ($this,$object) = @_;
79cdd6c86409 JSON support (experimental)
wizard
parents:
diff changeset
49
79cdd6c86409 JSON support (experimental)
wizard
parents:
diff changeset
50 my $propList = $this->cacheClassProps->{ref $object};
79cdd6c86409 JSON support (experimental)
wizard
parents:
diff changeset
51 unless ($propList) {
79cdd6c86409 JSON support (experimental)
wizard
parents:
diff changeset
52 # derived first, then own properties, only public
79cdd6c86409 JSON support (experimental)
wizard
parents:
diff changeset
53 my %props = map { $_->name, $_ } $this->get_meta( 'IMPL::Class::PropertyInfo', sub { $_->Access == IMPL::Class::Member::MOD_PUBLIC } , 1 );
79cdd6c86409 JSON support (experimental)
wizard
parents:
diff changeset
54 $this->cacheClassProps->{ref $object} = $propList = [keys %props];
79cdd6c86409 JSON support (experimental)
wizard
parents:
diff changeset
55
79cdd6c86409 JSON support (experimental)
wizard
parents:
diff changeset
56 }
79cdd6c86409 JSON support (experimental)
wizard
parents:
diff changeset
57
79cdd6c86409 JSON support (experimental)
wizard
parents:
diff changeset
58 return {
79cdd6c86409 JSON support (experimental)
wizard
parents:
diff changeset
59 map {
79cdd6c86409 JSON support (experimental)
wizard
parents:
diff changeset
60 $_,
79cdd6c86409 JSON support (experimental)
wizard
parents:
diff changeset
61 $this->Transform($object->$_())
79cdd6c86409 JSON support (experimental)
wizard
parents:
diff changeset
62 } @$propList
79cdd6c86409 JSON support (experimental)
wizard
parents:
diff changeset
63 };
79cdd6c86409 JSON support (experimental)
wizard
parents:
diff changeset
64 }
79cdd6c86409 JSON support (experimental)
wizard
parents:
diff changeset
65 }
79cdd6c86409 JSON support (experimental)
wizard
parents:
diff changeset
66 );
79cdd6c86409 JSON support (experimental)
wizard
parents:
diff changeset
67
79cdd6c86409 JSON support (experimental)
wizard
parents:
diff changeset
68 sub CTOR {
79cdd6c86409 JSON support (experimental)
wizard
parents:
diff changeset
69 my ($this) = @_;
79cdd6c86409 JSON support (experimental)
wizard
parents:
diff changeset
70
79cdd6c86409 JSON support (experimental)
wizard
parents:
diff changeset
71 $this->cacheClassProps({});
79cdd6c86409 JSON support (experimental)
wizard
parents:
diff changeset
72 }
79cdd6c86409 JSON support (experimental)
wizard
parents:
diff changeset
73
79cdd6c86409 JSON support (experimental)
wizard
parents:
diff changeset
74 1;
79cdd6c86409 JSON support (experimental)
wizard
parents:
diff changeset
75
79cdd6c86409 JSON support (experimental)
wizard
parents:
diff changeset
76 __END__
79cdd6c86409 JSON support (experimental)
wizard
parents:
diff changeset
77
79cdd6c86409 JSON support (experimental)
wizard
parents:
diff changeset
78 =pod
79cdd6c86409 JSON support (experimental)
wizard
parents:
diff changeset
79
79cdd6c86409 JSON support (experimental)
wizard
parents:
diff changeset
80 =cut