C4/Service.pm

   1 package C4::Service;
   2 #
   3 # Copyright 2008 LibLime
   4 #
   5 # This file is part of Koha.
   6 #
   7 # Koha is free software; you can redistribute it and/or modify it
   8 # under the terms of the GNU General Public License as published by
   9 # the Free Software Foundation; either version 3 of the License, or
  10 # (at your option) any later version.
  11 #
  12 # Koha is distributed in the hope that it will be useful, but
  13 # WITHOUT ANY WARRANTY; without even the implied warranty of
  14 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  15 # GNU General Public License for more details.
  16 #
  17 # You should have received a copy of the GNU General Public License
  18 # along with Koha; if not, see <http://www.gnu.org/licenses>.
  19
  20 =head1 NAME
  21
  22 C4::Service - functions for JSON webservices.
  23
  24 =head1 SYNOPSIS
  25
  26 my ( $query, $response) = C4::Service->init( { circulate => 1 } );
  27 my ( $borrowernumber) = C4::Service->require_params( 'borrowernumber' );
  28
  29 C4::Service->return_error( 'internal', 'Frobnication failed', frobnicator => 'foo' );
  30
  31 $response->param( frobnicated => 'You' );
  32
  33 C4::Service->return_success( $response );
  34
  35 =head1 DESCRIPTION
  36
  37 This module packages several useful functions for JSON webservices.
  38
  39 =cut
  40
  41 use strict;
  42 use warnings;
  43
  44 use CGI qw ( -utf8 );
  45 use C4::Auth qw( check_api_auth );
  46 use C4::Output qw( :ajax );
  47 use C4::Output::JSONStream;
  48 use JSON;
  49
  50 our $debug;
  51
  52 BEGIN {
  53     $debug = $ENV{DEBUG} || 0;
  54 }
  55
  56 our ( $query, $cookie );
  57
  58 sub _output {
  59     my ( $response, $status ) = @_;
  60     binmode STDOUT, ':encoding(UTF-8)';
  61
  62     if ( $query->param( 'callback' ) ) {
  63         output_with_http_headers $query, $cookie, $query->param( 'callback' ) . '(' . $response->output . ');', 'js';
  64     } else {
  65         output_with_http_headers $query, $cookie, $response->output, 'json', $status;
  66     }
  67 }
  68
  69 =head1 METHODS
  70
  71 =head2 init
  72
  73    our ( $query, $response ) = C4::Service->init( %needed_flags );
  74
  75 Initialize the service and check for the permissions in C<%needed_flags>.
  76
  77 Also, check that the user is authorized and has a current session, and return an
  78 'auth' error if not.
  79
  80 init() returns a C<CGI> object and a C<C4::Output::JSONStream>. The latter can
  81 be used for both flat scripts and those that use dispatch(), and should be
  82 passed to C<return_success()>.
  83
  84 =cut
  85
  86 sub init {
  87     my ( $class, %needed_flags ) = @_;
  88
  89     our $query = CGI->new;
  90
  91     my ( $status, $cookie_, $sessionID ) = check_api_auth( $query, \%needed_flags );
  92
  93     our $cookie = $cookie_; # I have no desire to offend the Perl scoping gods
  94
  95     $class->return_error( 'auth', $status ) if ( $status ne 'ok' );
  96
  97     return ( $query, C4::Output::JSONStream->new );
  98 }
  99
 100 =head2 return_error
 101
 102     C4::Service->return_error( $type, $error, %flags );
 103
 104 Exit the script with HTTP status 400, and return a JSON error object.
 105
 106 C<$type> should be a short, lower case code for the generic type of error (such
 107 as 'auth' or 'input').
 108
 109 C<$error> should be a more specific code giving information on the error. If
 110 multiple errors of the same type occurred, they should be joined by '|'; i.e.,
 111 'expired|different_ip'. Information in C<$error> does not need to be
 112 human-readable, as its formatting should be handled by the client.
 113
 114 Any additional information to be given in the response should be passed as
 115 param => value pairs.
 116
 117 =cut
 118
 119 sub return_error {
 120     my ( $class, $type, $error, %flags ) = @_;
 121
 122     my $response = C4::Output::JSONStream->new;
 123
 124     $response->param( message => $error ) if ( $error );
 125     $response->param( type => $type, %flags );
 126
 127     _output( $response, '400 Bad Request' );
 128     exit;
 129 }
 130
 131 =head2 return_multi
 132
 133     C4::Service->return_multi( \@responses, %flags );
 134
 135 return_multi is similar to return_success or return_error, but allows you to
 136 return different statuses for several requests sent at once (using HTTP status
 137 "207 Multi-Status", much like WebDAV). The toplevel hashref (turned into the
 138 JSON response) looks something like this:
 139
 140     { multi => JSON::true, responses => \@responses, %flags }
 141
 142 Each element of @responses should be either a plain hashref or an arrayref. If
 143 it is a hashref, it is sent to the browser as-is. If it is an arrayref, it is
 144 assumed to be in the same form as the arguments to return_error, and is turned
 145 into an error structure.
 146
 147 All key-value pairs %flags are, as stated above, put into the returned JSON
 148 structure verbatim.
 149
 150 =cut
 151
 152 sub return_multi {
 153     my ( $class, $responses, @flags ) = @_;
 154
 155     my $response = C4::Output::JSONStream->new;
 156
 157     if ( !@$responses ) {
 158         $class->return_success( $response );
 159     } else {
 160         my @responses_formatted;
 161
 162         foreach my $response ( @$responses ) {
 163             if ( ref( $response ) eq 'ARRAY' ) {
 164                 my ($type, $error, @error_flags) = @$response;
 165
 166                 push @responses_formatted, { is_error => JSON::true, type => $type, message => $error, @error_flags };
 167             } else {
 168                 push @responses_formatted, $response;
 169             }
 170         }
 171
 172         $response->param( 'multi' => JSON::true, responses => \@responses_formatted, @flags );
 173         _output( $response, '207 Multi-Status' );
 174     }
 175
 176     exit;
 177 }
 178
 179 =head2 return_success
 180
 181     C4::Service->return_success( $response );
 182
 183 Print out the information in the C<C4::Output::JSONStream> C<$response>, then
 184 exit with HTTP status 200.
 185
 186 =cut
 187
 188 sub return_success {
 189     my ( $class, $response ) = @_;
 190
 191     _output( $response );
 192 }
 193
 194 =head2 require_params
 195
 196     my @values = C4::Service->require_params( @params );
 197
 198 Check that each of of the parameters specified in @params was sent in the
 199 request, then return their values in that order.
 200
 201 If a required parameter is not found, send a 'param' error to the browser.
 202
 203 =cut
 204
 205 sub require_params {
 206     my ( $class, @params ) = @_;
 207
 208     my @values;
 209
 210     for my $param ( @params ) {
 211         $class->return_error( 'params', "Missing '$param'" ) if ( !defined( $query->param( $param ) ) );
 212         push @values, scalar $query->param( $param ); # will we ever need multi_param here?
 213     }
 214
 215     return @values;
 216 }
 217
 218 =head2 dispatch
 219
 220     C4::Service->dispatch(
 221         [ $path_regex, \@required_params, \&handler ],
 222         ...
 223     );
 224
 225 dispatch takes several array-refs, each one describing a 'route', to use the
 226 Rails terminology.
 227
 228 $path_regex should be a string in regex-form, describing which methods and
 229 paths this route handles. Each route is tested in order, from the top down, so
 230 put more specific handlers first. Also, the regex is tested on the request
 231 method, plus the path. For instance, you might use the route [ 'POST /', ... ]
 232 to handle POST requests to your service.
 233
 234 Each named parameter in @required_params is tested for to make sure the route
 235 matches, but does not raise an error if one is missing; it simply tests the next
 236 route. If you would prefer to raise an error, instead use
 237 C<C4::Service->require_params> inside your handler.
 238
 239 \&handler is called with each matched group in $path_regex in its arguments. For
 240 example, if your service is accessed at the path /blah/123, and you call
 241 C<dispatch> with the route [ 'GET /blah/(\\d+)', ... ], your handler will be called
 242 with the argument '123'.
 243
 244 =cut
 245
 246 sub dispatch {
 247     my $class = shift;
 248
 249     my $path_info = $query->path_info || '/';
 250
 251     ROUTE: foreach my $route ( @_ ) {
 252         my ( $path, $params, $handler ) = @$route;
 253
 254         next unless ( my @match = ( ($query->request_method . ' ' . $path_info)   =~ m,^$path$, ) );
 255
 256         for my $param ( @$params ) {
 257             next ROUTE if ( !defined( $query->param ( $param ) ) );
 258         }
 259
 260         $debug and warn "Using $path";
 261         $handler->( @match );
 262         return;
 263     }
 264
 265     $class->return_error( 'no_handler', '' );
 266 }
 267
 268 1;
 269
 270 __END__
 271
 272 =head1 AUTHORS
 273
 274 Koha Development Team
 275
 276 Jesse Weaver <jesse.weaver@liblime.com>