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