← Index
NYTProf Performance Profile   « line view »
For svc/members/upsert
  Run on Tue Jan 13 11:50:22 2015
Reported on Tue Jan 13 12:09:50 2015

Filename/mnt/catalyst/koha/C4/Service.pm
StatementsExecuted 37 statements in 10.4ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
11110.6ms256msC4::Service::::BEGIN@49C4::Service::BEGIN@49
11110.2ms71.7msC4::Service::::BEGIN@48C4::Service::BEGIN@48
1113.75ms10.1msC4::Service::::BEGIN@50C4::Service::BEGIN@50
1112.96ms3.72msC4::Service::::BEGIN@51C4::Service::BEGIN@51
111449µs472µsC4::Service::::BEGIN@44C4::Service::BEGIN@44
11131µs3.28msC4::Service::::return_errorC4::Service::return_error
11127µs24.5msC4::Service::::newC4::Service::new
11111µs17µsC4::Service::::BEGIN@45C4::Service::BEGIN@45
1118µs41µsC4::Service::::BEGIN@47C4::Service::BEGIN@47
1114µs4µsC4::Service::::BEGIN@55C4::Service::BEGIN@55
1114µs4µsC4::Service::::queryC4::Service::query
0000s0sC4::Service::::dispatchC4::Service::dispatch
0000s0sC4::Service::::output_streamC4::Service::output_stream
0000s0sC4::Service::::require_paramsC4::Service::require_params
0000s0sC4::Service::::return_multiC4::Service::return_multi
0000s0sC4::Service::::return_successC4::Service::return_success
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments		 Time
on line		 Calls Time
in subs		 Code
1package 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 under the
8# terms of the GNU General Public License as published by the Free Software
9# Foundation; either version 2 of the License, or (at your option) any later
10# version.
11#
12# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
13# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
14# A PARTICULAR PURPOSE. See the GNU General Public License for more details.
15#
16# You should have received a copy of the GNU General Public License along
17# with Koha; if not, write to the Free Software Foundation, Inc.,
18# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
19
20=head1 NAME
21
22C4::Service - functions for JSON webservices.
23
24=head1 SYNOPSIS
25
26my $response = C4::Output::XMLStream->new(...);
27my $service = C4::Service->new( { needed_flags => { circulate => 1 },
28 [ output_stream => $response ],
29 [ query => CGI->new() ] } );
30my ( $borrowernumber) = $service->require_params( 'borrowernumber' );
31
32$service->return_error( 'internal', 'Frobnication failed', frobnicator => 'foo' );
33
34$response->param( frobnicated => 'You' );
35
36C4::Service->return_success();
37
38=head1 DESCRIPTION
39
40This module packages several useful functions for webservices.
41
42=cut
43
44232µs2495µs
# spent 472µs (449+23) within C4::Service::BEGIN@44 which was called: # once (449µs+23µs) by main::BEGIN@75 at line 44
use strict;
# spent 472µs making 1 call to C4::Service::BEGIN@44 # spent 23µs making 1 call to strict::import
45223µs223µs
# spent 17µs (11+6) within C4::Service::BEGIN@45 which was called: # once (11µs+6µs) by main::BEGIN@75 at line 45
use warnings;
# spent 17µs making 1 call to C4::Service::BEGIN@45 # spent 6µs making 1 call to warnings::import
46
47223µs273µs
# spent 41µs (8+32) within C4::Service::BEGIN@47 which was called: # once (8µs+32µs) by main::BEGIN@75 at line 47
use Carp;
# spent 41µs making 1 call to C4::Service::BEGIN@47 # spent 32µs making 1 call to Exporter::import
482683µs271.7ms
# spent 71.7ms (10.2+61.5) within C4::Service::BEGIN@48 which was called: # once (10.2ms+61.5ms) by main::BEGIN@75 at line 48
use CGI;
# spent 71.7ms making 1 call to C4::Service::BEGIN@48 # spent 10µs making 1 call to CGI::import
4922.78ms2257ms
# spent 256ms (10.6+246) within C4::Service::BEGIN@49 which was called: # once (10.6ms+246ms) by main::BEGIN@75 at line 49
use C4::Auth qw( check_api_auth );
# spent 256ms making 1 call to C4::Service::BEGIN@49 # spent 89µs making 1 call to Exporter::import
5022.70ms210.3ms
# spent 10.1ms (3.75+6.38) within C4::Service::BEGIN@50 which was called: # once (3.75ms+6.38ms) by main::BEGIN@75 at line 50
use C4::Output qw( :ajax );
# spent 10.1ms making 1 call to C4::Service::BEGIN@50 # spent 126µs making 1 call to Exporter::import
5123.28ms13.72ms
# spent 3.72ms (2.96+766µs) within C4::Service::BEGIN@51 which was called: # once (2.96ms+766µs) by main::BEGIN@75 at line 51
use C4::Output::JSONStream;
# spent 3.72ms making 1 call to C4::Service::BEGIN@51
52
531200nsour $debug;
54
55
# spent 4µs within C4::Service::BEGIN@55 which was called: # once (4µs+0s) by main::BEGIN@75 at line 57
BEGIN {
5615µs $debug = $ENV{DEBUG} || 0;
571708µs14µs}
# spent 4µs making 1 call to C4::Service::BEGIN@55
58
59=head1 METHODS
60
61=head2 new
62
63 my $service = C4::Service->new({needed_flags => { parameters => 1 },
64 [ output_stream => C4::Output::XMLStream->new(...) ],
65 [ query => CGI->new() ]});
66
67Creates a new instance of C4::Service. It verifies that the provided flags
68are met by the current session, and aborts with an exit() call if they're
69not. It also accepts an instance of C4::Output::* (or something with the
70same interface) to use to generate the output. If none is provided, then
71a new instance of L<C4::Output::JSONStream> is created. Similarly, a query
72may also be provided. If it's not, a new CGI one will be created.
73
74TODO: exit sucks, make a better way.
75
76=cut
77
78
# spent 24.5ms (27µs+24.5) within C4::Service::new which was called: # once (27µs+24.5ms) by main::process_upsert at line 82 of svc/members/upsert
sub new {
791600ns my $class = shift;
80
8112µs my %opts = %{shift()};
82
831500ns my $needed_flags = $opts{needed_flags};
841300ns croak "needed_flags is a required option" unless $needed_flags;
85
8614µs12.81ms my $query = $opts{query} || CGI->new();
# spent 2.81ms making 1 call to CGI::new
87121µs324.5ms my ( $status, $cookie, $sessionID ) = check_api_auth( $query, $needed_flags );
# spent 21.7ms making 1 call to C4::Auth::check_api_auth # spent 2.75ms making 1 call to CGI::Session::DESTROY # spent 45µs making 1 call to CGI::Session::Driver::DBI::DESTROY
88
8914µs18µs my $output_stream = $opts{output_stream} || C4::Output::JSONStream->new();
# spent 8µs making 1 call to C4::Output::JSONStream::new
9012µs my $self = {
91 needed_flags => $needed_flags,
92 query => $query,
93 output_stream => $output_stream,
94 cookie => $cookie,
95 };
9611µs bless $self, $class;
971700ns $self->return_error('auth', $status) if ($status ne 'ok');
98
9914µs return $self;
100}
101
102=head2 return_error
103
104 $service->return_error( $type, $error, %flags );
105
106Exit the script with HTTP status 400, and return a JSON error object.
107
108C<$type> should be a short, lower case code for the generic type of error (such
109as 'auth' or 'input').
110
111C<$error> should be a more specific code giving information on the error. If
112multiple errors of the same type occurred, they should be joined by '|'; i.e.,
113'expired|different_ip'. Information in C<$error> does not need to be
114human-readable, as its formatting should be handled by the client.
115
116Any additional information to be given in the response should be passed as
117param => value pairs.
118
119=cut
120
121
# spent 3.28ms (31µs+3.25) within C4::Service::return_error which was called: # once (31µs+3.25ms) by main::process_upsert at line 152 of svc/members/upsert
sub return_error {
1221800ns my ( $self, $type, $error, %flags ) = @_;
123
1241600ns my $response = $self->{output_stream};
12512µs16µs $response->clear();
# spent 6µs making 1 call to C4::Output::JSONStream::clear
126
12714µs110µs $response->param( message => $error ) if ( $error );
# spent 10µs making 1 call to C4::Output::JSONStream::param
12812µs116µs $response->param( type => $type, %flags );
# spent 16µs making 1 call to C4::Output::JSONStream::param
129
13017µs33.22ms output_with_http_headers $self->{query}, $self->{cookie}, $response->output, $response->content_type, '400 Bad Request';
# spent 3.17ms making 1 call to C4::Output::output_with_http_headers # spent 52µs making 1 call to C4::Output::JSONStream::output # spent 2µs making 1 call to C4::Output::JSONStream::content_type
1311137µs2020.7ms exit;
# spent 19.6ms making 1 call to File::Temp::END # spent 934µs making 2 calls to Date::Manip::Zones::END, avg 467µs/call # spent 56µs making 1 call to DBI::END # spent 28µs making 1 call to XML::LibXML::END # spent 10µs making 2 calls to Date::Manip::TZ::END, avg 5µs/call # spent 6µs making 2 calls to Date::Manip::TZ::etgmt00::END, avg 3µs/call # spent 5µs making 1 call to Date::Manip::Recur::END # spent 4µs making 1 call to Date::Manip::Date::END # spent 3µs making 1 call to Date::Manip::Base::END # spent 3µs making 1 call to Date::Manip::Obj::END # spent 3µs making 1 call to Date::Manip::Delta::END # spent 3µs making 1 call to C4::Accounts::END # spent 2µs making 1 call to C4::Output::END # spent 2µs making 1 call to C4::Members::END # spent 2µs making 1 call to Date::Manip::TZ_Base::END # spent 2µs making 1 call to C4::Auth::END # spent 2µs making 1 call to C4::Budgets::END
132}
133
134=head2 return_multi
135
136 $service->return_multi( \@responses, %flags );
137
138return_multi is similar to return_success or return_error, but allows you to
139return different statuses for several requests sent at once (using HTTP status
140"207 Multi-Status", much like WebDAV). The toplevel hashref (turned into the
141JSON response) looks something like this:
142
143 { multi => JSON::true, responses => \@responses, %flags }
144
145Each element of @responses should be either a plain hashref or an arrayref. If
146it is a hashref, it is sent to the browser as-is. If it is an arrayref, it is
147assumed to be in the same form as the arguments to return_error, and is turned
148into an error structure.
149
150All key-value pairs %flags are, as stated above, put into the returned JSON
151structure verbatim.
152
153=cut
154
155sub return_multi {
156 my ( $self, $responses, @flags ) = @_;
157
158 my $response = $self->{output_stream};
159 $response->clear();
160
161 if ( !@$responses ) {
162 $self->return_success( $response );
163 } else {
164 my @responses_formatted;
165
166 foreach my $response ( @$responses ) {
167 if ( ref( $response ) eq 'ARRAY' ) {
168 my ($type, $error, @error_flags) = @$response;
169
170 push @responses_formatted, { is_error => $response->true(), type => $type, message => $error, @error_flags };
171 } else {
172 push @responses_formatted, $response;
173 }
174 }
175
176 $response->param( 'multi' => $response->true(), responses => \@responses_formatted, @flags );
177 output_with_http_headers $self->{query}, $self->{cookie}, $response->output, $response->content_type, '207 Multi-Status';
178 }
179
180 exit;
181}
182
183=head2 return_success
184
185 $service->return_success();
186
187Print out the information in the provided C<output_stream>, then
188exit with HTTP status 200. To get access to the C<output_stream>, you should
189either use the one that you provided, or you should use the C<output_stream()>
190accessor.
191
192=cut
193
194sub return_success {
195 my ( $self ) = @_;
196
197 my $response = $self->{output_stream};
198 output_with_http_headers $self->{query}, $self->{cookie}, $response->output, $response->content_type;
199}
200
201=head2 output_stream
202
203 $service->output_stream();
204
205Provides the output stream object that is in use so that data can be added
206to it.
207
208=cut
209
210sub output_stream {
211 my $self = shift;
212
213 return $self->{output_stream};
214}
215
216=head2 query
217
218 $service->query();
219
220Provides the query object that this class is using.
221
222=cut
223
224
# spent 4µs within C4::Service::query which was called: # once (4µs+0s) by main::process_upsert at line 84 of svc/members/upsert
sub query {
2251400ns my $self = shift;
226
22716µs return $self->{query};
228}
229
230=head2 require_params
231
232 my @values = $service->require_params( @params );
233
234Check that each of of the parameters specified in @params was sent in the
235request, then return their values in that order.
236
237If a required parameter is not found, send a 'param' error to the browser.
238
239=cut
240
241sub require_params {
242 my ( $self, @params ) = @_;
243
244 my @values;
245
246 for my $param ( @params ) {
247 $self->return_error( 'params', "Missing '$param'" ) if ( !defined( $self->{query}->param( $param ) ) );
248 push @values, $self->{query}->param( $param );
249 }
250
251 return @values;
252}
253
254=head2 dispatch
255
256 $service->dispatch(
257 [ $path_regex, \@required_params, \&handler ],
258 ...
259 );
260
261dispatch takes several array-refs, each one describing a 'route', to use the
262Rails terminology.
263
264$path_regex should be a string in regex-form, describing which methods and
265paths this route handles. Each route is tested in order, from the top down, so
266put more specific handlers first. Also, the regex is tested on the request
267method, plus the path. For instance, you might use the route [ 'POST /', ... ]
268to handle POST requests to your service.
269
270Each named parameter in @required_params is tested for to make sure the route
271matches, but does not raise an error if one is missing; it simply tests the next
272route. If you would prefer to raise an error, instead use
273C<C4::Service->require_params> inside your handler.
274
275\&handler is called with each matched group in $path_regex in its arguments. For
276example, if your service is accessed at the path /blah/123, and you call
277C<dispatch> with the route [ 'GET /blah/(\\d+)', ... ], your handler will be called
278with the argument '123'.
279
280=cut
281
282sub dispatch {
283 my $self = shift;
284
285 my $query = $self->{query};
286 my $path_info = $query->path_info || '/';
287
288 ROUTE: foreach my $route ( @_ ) {
289 my ( $path, $params, $handler ) = @$route;
290
291 next unless ( my @match = ( ($query->request_method . ' ' . $path_info) =~ m,^$path$, ) );
292
293 for my $param ( @$params ) {
294 next ROUTE if ( !defined( $query->param ( $param ) ) );
295 }
296
297 $debug and warn "Using $path";
298 $handler->( @match );
299 return;
300 }
301
302 $self->return_error( 'no_handler', '' );
303}
304
30514µs1;
306
307__END__
Report produced by the NYTProf 5.06 Perl profiler, developed by Tim Bunce and Adam Kaplan.