1#!/usr/bin/perl
2
3package JSON::RPC::Common::Procedure::Return;
4$JSON::RPC::Common::Procedure::Return::VERSION = '0.11';
5use Moose;
6# ABSTRACT: JSON-RPC procedure return class
7
8use Carp qw(croak);
9
10use JSON::RPC::Common::TypeConstraints qw(JSONValue);
11use JSON::RPC::Common::Procedure::Return::Error;
12
13use namespace::clean -except => [qw(meta)];
14
15with qw(JSON::RPC::Common::Message);
16
17around new_from_data => sub {
18	my $next = shift;
19	my ( $class, %args ) = @_;
20
21	if ( defined(my $error = delete $args{error}) ) {
22		$args{error} = $class->inflate_error($error, %args);
23	}
24
25	return $class->$next(%args);
26};
27
28has version => (
29	isa => "Str",
30	is  => "rw",
31	predicate => "has_version",
32);
33
34has result => (
35	isa => "Any",
36	is  => "rw",
37	predicate => "has_result",
38);
39
40has id => (
41	isa => JSONValue,
42	is  => "rw",
43	predicate => "has_id",
44);
45
46has error_class => (
47	isa => "ClassName",
48	is  => "rw",
49	default => "JSON::RPC::Common::Procedure::Return::Error",
50);
51
52has error => (
53	isa => "JSON::RPC::Common::Procedure::Return::Error",
54	is  => "rw",
55	predicate => "has_error",
56);
57
58sub deflate {
59	my $self = shift;
60
61	my $version = $self->version;
62
63	$version = "undefined" unless defined $version;
64
65	croak "Deflating a procedure return of the class " . ref($self) . " is not supported (version is $version)";
66}
67
68sub deflate_error {
69	my $self = shift;
70
71	if ( my $error = $self->error ) {
72		return $error->deflate;
73	} else {
74		return undef;
75	}
76}
77
78sub inflate_error {
79	my ( $self, $error ) = @_;
80
81	my $error_class = ref $self
82		? $self->error_class
83		: $self->meta->find_attribute_by_name("error_class")->default;
84
85	$error_class->inflate($error);
86}
87
88sub set_error {
89	my ( $self, @args ) = @_;
90
91	$self->error( $self->create_error(@args) );
92}
93
94sub create_error {
95	my ( $self, @args ) = @_;
96	$self->error_class->new_dwim(@args);
97}
98
99__PACKAGE__->meta->make_immutable;
100
101__PACKAGE__
102
103__END__
104
105=pod
106
107=head1 NAME
108
109JSON::RPC::Common::Procedure::Return - JSON-RPC procedure return class
110
111=head1 VERSION
112
113version 0.11
114
115=head1 SYNOPSIS
116
117	use JSON::RPC::Common::Procedure::Return;
118
119	# create a return from a call, retaining the ID
120	my $return = $call->return_result("foo");
121
122	# inflate gets a version specific class
123	my $return = JSON::RPC::Common::Procedure::Return->inflate(
124		version => "2.0",
125		result  => "foo",
126		id      => $id,
127	);
128
129	# you can specify a return with an error, it's just an attribute
130	my $return = JSON::RPC::Common::Procedure::Return->new(
131		error => ...,
132	);
133
134=head1 DESCRIPTION
135
136This class abstracts JSON-RPC procedure returns (results).
137
138Version specific implementation are provided as well.
139
140=head1 ATTRIBUTES
141
142=over 4
143
144=item id
145
146The ID of the call this is a result for.
147
148Results with no ID are typically error results for parse fails, when the call
149ID could never be determined.
150
151=item result
152
153The JSON data that is the result of the call, if any.
154
155=item error
156
157The error, if any. This is a L<JSON::RPC::Common::Procedure::Return::Error>
158object (or a version specific subclass).
159
160=item error_class
161
162The error class to use when instantiating errors.
163
164=back
165
166=head1 METHODS
167
168=over 4
169
170=item inflate
171
172=item deflate
173
174Go to and from JSON data.
175
176=item inflate_error
177
178=item deflate_error
179
180Helpers for managing the error sub object.
181
182=item set_error
183
184Calls C<create_error> with it's arguments and sets the error to that.
185
186E.g.
187
188	$res->set_error("foo");
189	$res->error->message; # "foo"
190
191=item create_error
192
193Instantiate a new error of class L<error_class> using
194L<JSON::RPC::Common::Procedure::Return::Error/new_dwim>.
195
196=back
197
198=head1 AUTHOR
199
200Yuval Kogman <nothingmuch@woobling.org>
201
202=head1 COPYRIGHT AND LICENSE
203
204This software is copyright (c) 2014 by Yuval Kogman and others.
205
206This is free software; you can redistribute it and/or modify it under
207the same terms as the Perl 5 programming language system itself.
208
209=cut
210