From 2be4ac7756bade25e12556833eb0017123f60a90 Mon Sep 17 00:00:00 2001 From: Jesse Weaver Date: Mon, 9 Feb 2015 07:08:52 -0500 Subject: [PATCH] Bug 12272 - Add new Koha::Service class --- Koha/Service.pm | 324 ++++++++++++++++++++++++++++++++++++++++++ svc/bib | 27 +--- svc/bib_profile | 45 +++---- svc/config/systempreferences | 116 ++------------- 4 files changed, 358 insertions(+), 154 deletions(-) create mode 100644 Koha/Service.pm diff --git a/Koha/Service.pm b/Koha/Service.pm new file mode 100644 index 0000000..0e7e31b --- /dev/null +++ b/Koha/Service.pm @@ -0,0 +1,324 @@ +package Koha::Service; + +# This file is part of Koha. +# +# Copyright (C) 2014 ByWater Solutions +# +# Koha is free software; you can redistribute it and/or modify it +# under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 3 of the License, or +# (at your option) any later version. +# +# Koha is distributed in the hope that it will be useful, but +# WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with Koha; if not, see . + +=head1 NAME + +Koha::Service - base class for webservices. + +=head1 SYNOPSIS + +package Koha::Service::Frobnicator; + +use base 'Koha::Service'; + +sub new { + my ( $class ) = @_; + + return $class::SUPER::new( { frobnicate => 1 } ); +} + +sub run { + my ( $self ) = @_; + + my ( $query, $cookie ) = $self->authenticate; + my ( $borrowernumber ) = $self->require_params( 'borrowernumber' ); + + $self->croak( 'internal', 'Frobnication failed', { frobnicator => 'foo' } ); + + $self->output({ frobnicated => 'You' }); +} + +Koha::Service::Frobnicator->new->run; + +=head1 DESCRIPTION + +This module serves as a base class with utility methods for JSON webservices. + +=head1 METHODS + +=cut + +use Modern::Perl; + +use base 'Class::Accessor'; + +use C4::Auth qw( check_api_auth ); +use C4::Output qw( :ajax ); +use CGI; +use JSON; + +our $debug; + +BEGIN { + $debug = $ENV{DEBUG} || 0; +} + +__PACKAGE__->mk_accessors( qw( auth_status query cookie ) ); + +=head2 new + + my $self = $class->SUPER::new( \%options ); + +Base constructor for a service. + +C<\%options> may contain the following: + +=over + +=item authnotrequired + +Defaults to false. If set, means that C will not croak if the user is not logged in. + +=item needed_flags + +Takes a hashref of required permissions, i.e., { circulation => +'circulate_remaining_permissions' }. + +=item routes + +An arrayref of routes; see C for the required format. + +=back + +=cut + +sub new { + my ( $class, $options ) = @_; + + return bless { + authnotrequired => 0, + needed_flags => { catalogue => 1 }, + routes => [], + %$options + }, $class; +} + +=head2 authenticate + + my ( $query, $cookie ) = $self->authenticate(); + +Authenticates the user and returns a C object and cookie. May exit after sending an 'auth' +error if the user is not logged in or does not have the right permissions. + +This must be called before the C or C methods. + +=cut + +sub authenticate { + my ( $self ) = @_; + + $self->query(CGI->new); + + my ( $status, $cookie, $sessionID ) = check_api_auth( $self->query, $self->{needed_flags} ); + $self->cookie($cookie); + $self->auth_status($status); + $self->croak( 'auth', $status ) if ( $status ne 'ok' && !$self->{authnotrequired} ); + + return ( $self->query, $cookie ); +} + +=head2 output + + $self->output( $response[, \%options] ); + +Outputs C<$response>, with the correct headers. + +C<\%options> may contain the following: + +=over + +=item status + +The HTTP status line to send; defaults to '200 OK'. This parameter is ignored for JSONP, as a +non-200 response cannot be easily intercepted. + +=item type + +Either 'js', 'json', 'xml' or 'html'. Defaults to 'json'. If 'json', and the C query parameter +is given, outputs JSONP. + +=back + +=cut + +sub output { + my ( $self, $response, $options ) = @_; + + binmode STDOUT, ':encoding(UTF-8)'; + + # Set defaults + $options = { + status => '200 OK', + type => 'json', + %{ $options || {} }, + }; + + if ( $options->{type} eq 'json' ) { + $response = encode_json($response); + + if ( $self->query->param( 'callback' ) ) { + $response = $self->query->param( 'callback' ) . '(' . encode_json($response) . ');'; + $options->{status} = '200 OK'; + $options->{type} = 'js'; + } + } + + output_with_http_headers $self->query, $self->cookie, $response, $options->{type}, $options->{status}; +} + +=head2 croak + + $self->croak( $error, $detail, \%flags ); + +Outputs an error as JSON, then exits the service with HTTP status 400. + +C<$error> should be a short, lower case code for the generic type of error (such +as 'auth' or 'input'). + +C<$detail> should be a more specific code giving information on the error. If +multiple errors of the same type occurred, they should be joined by '|'; i.e., +'expired|different_ip'. Information in C<$error> does not need to be +human-readable, as its formatting should be handled by the client. + +Any additional information to be given in the response should be passed in \%flags. + +The final result of this is a JSON structure like so: + + { "error": "$error", "detail": "$detail", ... } + +=cut + +sub croak { + my ( $self, $type, $error, $flags ) = @_; + + my $response = $flags || {}; + + $response->{message} = $error; + $response->{error} = $type; + + $self->output( $response, { status => '400 Bad Request' } ); + exit; +} + +=head2 require_params + + my @values = $self->require_params( @params ); + +Check that each of of the parameters specified in @params was sent in the +request, then return their values in that order. + +If a required parameter is not found, send a 'param' error to the browser. + +=cut + +sub require_params { + my ( $self, @params ) = @_; + + my @values; + + for my $param ( @params ) { + $self->croak( 'params', "missing_$param" ) if ( !defined( $self->query->param( $param ) ) ); + push @values, $self->query->param( $param ); + } + + return @values; +} + +=head2 add_routes + + $self->add_routes( + [ $path_regex, $handler[, \@required_params] ], + ... + ); + +Adds several routes, each described by an arrayref. + +$path_regex should be a regex passed through qr//, describing which methods and +paths this route handles. Each route is tested in order, from the top down, so +put more specific handlers first. Also, the regex is tested on the request +method, plus the path. For instance, you might use the route [ qr'POST /', ... ] +to handle POST requests to your service. + +$handler should be the name of a method in the current class. + +If \@required_params is passed, each named parameter in it is tested to make sure the route matches. +No error is raised if one is missing; it simply tests the next route. If you would prefer to raise +an error, instead use C inside your handler. + +=cut + +sub add_routes { + my $self = shift; + + push @{ $self->{routes} }, @_; +} + +=sub dispatch + + $self->dispatch(); + +Dispatches to the correct route for the current URL and parameters, or raises a 'no_handler' error. + +$self->$handler is called with each matched group in $path_regex in its arguments. For +example, if your service is accessed at the path /blah/123, and you call +C with the route [ qr'GET /blah/(\d+)', ... ], your handler will be called +with the arguments '123'. The original C object and cookie are available as C<$self->query> and C<$self->cookie>. + +Returns the result of the matching handler. + +=cut + +sub dispatch { + my $self = shift; + + my $path_info = $self->query->path_info || '/'; + + ROUTE: foreach my $route ( @{ $self->{routes} } ) { + my ( $path, $handler, $params ) = @$route; + + next unless ( my @match = ( ($self->query->request_method . ' ' . $path_info) =~ m,^$path$, ) ); + + for my $param ( @{ $params || [] } ) { + next ROUTE if ( !defined( $self->query->param ( $param ) ) ); + } + + $debug and warn "Using $handler for $path"; + return $self->$handler( @match ); + } + + $self->croak( 'no_handler' ); +} + +=sub run + + $service->run(); + +Runs the service. By default, calls authenticate, dispatch then output, but can be overridden. + +=cut + +sub run { + my ( $self ) = @_; + + $self->authenticate; + my $result = $self->dispatch; + $self->output($result) if ($result); +} + +1; diff --git a/svc/bib b/svc/bib index ef1e41c..8f6a168 100755 --- a/svc/bib +++ b/svc/bib @@ -22,7 +22,7 @@ use strict; use warnings; -use CGI qw ( -utf8 ); +use CGI; use C4::Auth qw/check_api_auth/; use C4::Biblio; use C4::Items; @@ -48,17 +48,11 @@ if ($path_info =~ m!^/(\d+)$!) { print $query->header(-type => 'text/xml', -status => '400 Bad Request'); } -# are we retrieving, updating or deleting a bib? +# are we retrieving or updating a bib? if ($query->request_method eq "GET") { fetch_bib($query, $biblionumber); -} elsif ($query->request_method eq "POST") { - update_bib($query, $biblionumber); -} elsif ($query->request_method eq "DELETE") { - delete_bib($query, $biblionumber); } else { - print $query->header(-type => 'text/xml', -status => '405 Method not allowed'); - print XMLout({ error => 'Method not allowed' }, NoAttr => 1, RootName => 'response', XMLDecl => 1); - exit 0; + update_bib($query, $biblionumber); } exit 0; @@ -126,18 +120,3 @@ sub update_bib { print XMLout($result, NoAttr => 1, RootName => 'response', XMLDecl => 1, NoEscape => $do_not_escape); } - -sub delete_bib { - my $query = shift; - my $biblionumber = shift; - my $error = DelBiblio($biblionumber); - - if (defined $error) { - print $query->header(-type => 'text/xml', -status => '400 Bad request'); - print XMLout({ error => $error }, NoAttr => 1, RootName => 'response', XMLDecl => 1); - exit 0; - } - - print $query->header(-type => 'text/xml'); - print XMLout({ status => 'OK, biblio deleted' }, NoAttr => 1, RootName => 'response', XMLDecl => 1); -} diff --git a/svc/bib_profile b/svc/bib_profile index e7660f0..514c78b 100755 --- a/svc/bib_profile +++ b/svc/bib_profile @@ -1,23 +1,23 @@ #!/usr/bin/perl -# Copyright 2007 LibLime -# # This file is part of Koha. # -# Koha is free software; you can redistribute it and/or modify it under the -# terms of the GNU General Public License as published by the Free Software -# Foundation; either version 2 of the License, or (at your option) any later -# version. +# Copyright (C) 2014 ByWater Solutions # -# Koha is distributed in the hope that it will be useful, but WITHOUT ANY -# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR -# A PARTICULAR PURPOSE. See the GNU General Public License for more details. +# Koha is free software; you can redistribute it and/or modify it +# under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 3 of the License, or +# (at your option) any later version. # -# You should have received a copy of the GNU General Public License along -# with Koha; if not, write to the Free Software Foundation, Inc., -# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. +# Koha is distributed in the hope that it will be useful, but +# WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. # +# You should have received a copy of the GNU General Public License +# along with Koha; if not, see . +<<<<<<< HEAD use strict; use warnings; @@ -110,20 +110,9 @@ sub _get_bib_number_tag { } $result->{'bib_number'} = \@tags; } +======= +use Modern::Perl; +>>>>>>> 40908d6... New Koha::Service class, several services ported -sub _get_biblioitem_itemtypes { - my $result = shift; - my $itemtypes = GetItemTypes; - my $sth = $dbh->prepare_cached("SELECT tagfield, tagsubfield - FROM marc_subfield_structure - WHERE frameworkcode = '' - AND kohafield = 'biblioitems.itemtype'"); - $sth->execute(); - my @tags = (); - while (my $row = $sth->fetchrow_arrayref) { - push @tags, { tag => $row->[0], subfield => $row->[1] }; - } - my @valid_values = map { { code => $_, description => $itemtypes->{$_}->{'description'} } } sort keys %$itemtypes; - $result->{'special_entry'} = { field => \@tags, valid_values => \@valid_values }; - -} +use Koha::Service::BibProfile; +Koha::Service::BibProfile->new->run; diff --git a/svc/config/systempreferences b/svc/config/systempreferences index deeca51..bef8098 100755 --- a/svc/config/systempreferences +++ b/svc/config/systempreferences @@ -1,111 +1,23 @@ #!/usr/bin/perl -# Copyright 2009 Jesse Weaver -# # This file is part of Koha. # -# Koha is free software; you can redistribute it and/or modify it under the -# terms of the GNU General Public License as published by the Free Software -# Foundation; either version 2 of the License, or (at your option) any later -# version. +# Copyright (C) 2014 ByWater Solutions # -# Koha is distributed in the hope that it will be useful, but WITHOUT ANY -# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR -# A PARTICULAR PURPOSE. See the GNU General Public License for more details. +# Koha is free software; you can redistribute it and/or modify it +# under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 3 of the License, or +# (at your option) any later version. # -# You should have received a copy of the GNU General Public License along -# with Koha; if not, write to the Free Software Foundation, Inc., -# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. +# Koha is distributed in the hope that it will be useful, but +# WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. # +# You should have received a copy of the GNU General Public License +# along with Koha; if not, see . -use strict; -use warnings; - -use C4::Context; -use C4::Service; -use C4::Log; - -=head1 NAME - -svc/config/systempreferences - Web service for setting system preferences - -=head1 SYNOPSIS - - POST /svc/config/systempreferences/ - -=head1 DESCRIPTION - -This service is used to set system preferences, either one at a time or in -batches. - -=head1 METHODS - -=cut - -our ( $query, $response ) = C4::Service->init( parameters => 1 ); - -=head2 set_preference - -=over 4 - -POST /svc/config/systempreferences/$preference - -value=$value - -=back - -Used to set a single system preference. - -=cut - -sub set_preference { - my ( $preference ) = @_; - - unless ( C4::Context->config('demo') ) { - my $value = join( ',', $query->param( 'value' ) ); - C4::Context->set_preference( $preference, $value ); - logaction( 'SYSTEMPREFERENCE', 'MODIFY', undef, $preference . " | " . $value ); - } - - C4::Service->return_success( $response ); -} - -=head2 set_preferences - -=over 4 - -POST /svc/config/systempreferences/ - -pref_$pref1=$value1&pref_$pref2=$value2 - -=back - -Used to set several system preferences at once. Each preference you want to set -should be sent prefixed with pref. If you wanted to turn off the -virtualshelves syspref, for instance, you would POST the following: - -pref_virtualshelves=0 - -=cut - -sub set_preferences { - unless ( C4::Context->config( 'demo' ) ) { - foreach my $param ( $query->param() ) { - my ( $pref ) = ( $param =~ /pref_(.*)/ ); - - next if ( !defined( $pref ) ); - - my $value = join( ',', $query->param( $param ) ); - - C4::Context->set_preference( $pref, $value ); - logaction( 'SYSTEMPREFERENCE', 'MODIFY', undef, $pref . " | " . $value ); - } - } - - C4::Service->return_success( $response ); -} +use Modern::Perl; -C4::Service->dispatch( - [ 'POST /([A-Za-z0-9_-]+)', [ 'value' ], \&set_preference ], - [ 'POST /', [], \&set_preferences ], -); +use Koha::Service::Config::SystemPreferences; +Koha::Service::Config::SystemPreferences->new->run; -- 1.7.2.5