Bugzilla – Attachment 35455 Details for
Bug 13607
Patron management API
Home
|
New
|
Browse
|
Search
|
[?]
|
Reports
|
Help
|
New Account
|
Log In
[x]
|
Forgot Password
Login:
[x]
[patch]
Bug 13607: patron management API
Bug-13607-patron-management-API.patch (text/plain), 51.00 KB, created by
Robin Sheat
on 2015-01-22 01:32:23 UTC
(
hide
)
Description:
Bug 13607: patron management API
Filename:
MIME Type:
Creator:
Robin Sheat
Created:
2015-01-22 01:32:23 UTC
Size:
51.00 KB
patch
obsolete
>From 7093c7062a9ad5950d304f44cfe1067476cbba10 Mon Sep 17 00:00:00 2001 >From: Robin Sheat <robin@catalyst.net.nz> >Date: Tue, 9 Dec 2014 15:49:45 +1300 >Subject: [PATCH] Bug 13607: patron management API > >This provides a patron management API. It allows a remote service to: >* add patrons >* update patron details >* delete patrons > >It presents a simple POST-based API and returns its results as XML. >This API supports fields available in the borrower table, and extended >attribute types also. > >Full documentation will be on a wiki page linked to from the bug. > >To test: >* construct a sequence of API requests, make sure it works. >* ensure that no side effects of these changes came about, particularly > dealing with unrelated things (default_messageprefs.pl, > sco-patron-image.pl, systempreferences.) >--- > C4/Installer/PerlDependencies.pm | 5 + > C4/Output/JSONStream.pm | 41 +++++ > C4/Output/XMLStream.pm | 231 ++++++++++++++++++++++++++++ > C4/Service.pm | 157 +++++++++++++------ > Koha/Borrower/Search.pm | 149 ++++++++++++++++++ > members/default_messageprefs.pl | 5 +- > opac/sco/sco-patron-image.pl | 6 +- > svc/config/systempreferences | 14 +- > svc/members/delete | 154 +++++++++++++++++++ > svc/members/upsert | 317 +++++++++++++++++++++++++++++++++++++++ > t/Output_JSONStream.t | 11 +- > t/Output_XMLStream.t | 70 +++++++++ > t/Service.t | 71 +++++++++ > t/db_dependent/Borrower_Search.t | 79 ++++++++++ > t/db_dependent/Service.t | 14 -- > 15 files changed, 1252 insertions(+), 72 deletions(-) > create mode 100644 C4/Output/XMLStream.pm > create mode 100644 Koha/Borrower/Search.pm > create mode 100755 svc/members/delete > create mode 100755 svc/members/upsert > create mode 100644 t/Output_XMLStream.t > create mode 100755 t/Service.t > create mode 100755 t/db_dependent/Borrower_Search.t > delete mode 100755 t/db_dependent/Service.t > >diff --git a/C4/Installer/PerlDependencies.pm b/C4/Installer/PerlDependencies.pm >index 96557e3..c15b021 100644 >--- a/C4/Installer/PerlDependencies.pm >+++ b/C4/Installer/PerlDependencies.pm >@@ -737,6 +737,11 @@ our $PERL_DEPS = { > 'required' => '0', > 'min_ver' => '5.61', > }, >+ 'XML::Writer' => { >+ 'usage' => 'Core', >+ 'required' => '1', >+ 'min_ver' => '0.611', >+ }, > }; > > 1; >diff --git a/C4/Output/JSONStream.pm b/C4/Output/JSONStream.pm >index ff321fc..5153dba 100644 >--- a/C4/Output/JSONStream.pm >+++ b/C4/Output/JSONStream.pm >@@ -71,4 +71,45 @@ sub output { > return to_json( $self->{data} ); > } > >+=head 2 clear >+ >+ $json->clear(); >+ >+This clears any in-progress data from the object so it can be used to create >+something new. Parameters are kept, it's just the data that goes away. >+ >+=cut >+ >+sub clear { >+ my $self = shift; >+ $self->{data} = {}; >+} >+ >+=head2 content_type >+ >+ my $ct = $json->content_type(); >+ >+Returns a string containing the content type of the stuff that this class >+returns, suitable for passing to L<C4::JSONStream::output_with_http_headers>. >+In this case, it says 'json'. >+ >+=cut >+ >+sub content_type { >+ return 'json'; >+} >+ >+=head2 true >+ >+ my $true = $json->true(); >+ >+This provides a 'true' value, as some format types need a special value. >+ >+=cut >+ >+sub true { >+ return JSON::true; >+} >+ >+ > 1; >diff --git a/C4/Output/XMLStream.pm b/C4/Output/XMLStream.pm >new file mode 100644 >index 0000000..102540a >--- /dev/null >+++ b/C4/Output/XMLStream.pm >@@ -0,0 +1,231 @@ >+package C4::Output::XMLStream; >+ >+# Copyright 2014 Catalyst IT >+# >+# 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 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, write to the Free Software Foundation, Inc., >+# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. >+ >+=head1 NAME >+ >+C4::Output::XMLStream - progressively build XML data >+ >+=head1 SYNOPSIS >+ >+ my $xml = C4::Output::XMLStream->new(root => 'rootnodename'); >+ >+ $json->param( issues => [ 'yes!', 'please', 'no', { emphasis = 'NO' } ] ); >+ $json->param( stuff => 'realia' ); >+ >+ print $json->output; >+ >+=head1 DESCRIPTION >+ >+This module makes it easy to progressively build up data structure that can >+then be output as XML. >+ >+The XML output is very simple, as this is an analogue to JSON output. If >+params are set thus: >+ >+ my $json = C4::Output::XMLStream->new(root => 'rootnodename'); >+ $json->param( issues => [ 'yes!', 'please', 'no', { emphasis = 'NO' } ] ); >+ $json->param( stuff => 'realia' ); >+ >+Then the XML will be: >+ >+ <rootnodename> >+ <issues> >+ <array> >+ <item>yes!</item> >+ <item>please</item> >+ <item>no</item> >+ <emphasis>NO</emphasis> >+ </array> >+ </issues> >+ <stuff>realia</stuff> >+ </rootnodename> >+ >+It's wordy because it's XML. You can't set attributes on nodes, because you >+can't do that in JSON. You can't have text elements and sub-elements at the >+same time, because that's fiddly to express in Perl structures, and you can't >+do that in JSON anyway. >+ >+If you want multiple subnodes, then do this: >+ >+ $xml->param(stuff => { one => 'a', two => 'b' }); >+ >+The resulting order of the output is not particularly deterministic, given >+this more or less emulates a hash, except the bits with arrays. >+ >+If you add a new param with the same name as an already existing one, the new >+one will overwrite the old one. >+ >+=head1 FUNCTIONS >+ >+=cut >+ >+use Carp; >+use Modern::Perl; >+use XML::Writer; >+ >+=head2 new >+ >+ my $xml = C4::Output::XMLStream->new(root => 'rootnodename'); >+ >+Creates a new instance of the C<C4::Output::XMLStream> class. >+ >+=cut >+ >+sub new { >+ my $class = shift; >+ my %opts = @_; >+ croak "no root node specified" unless $opts{root}; >+ my $self = { >+ data => {}, >+ %opts, >+ }; >+ bless $self, $class; >+ return $self; >+} >+ >+=head2 param >+ >+ $xml->param(key1 => $value1, key2 => $value2, ...); >+ >+This adds the supplied key/value pairs to the object for later output. See >+the Description section for details on what goes in vs. what comes out. >+ >+=cut >+ >+sub param { >+ my $self = shift; >+ >+ if (@_ % 2 != 0) { >+ croak "param() received an odd number of args, should be a list of hashes"; >+ } >+ >+ my %p = @_; >+ # Merge the hashes, this'll overwrite any old values with new ones >+ @{ $self->{data} }{ keys %p } = values %p; >+} >+ >+=head2 output >+ >+ my $str = $xml->output(); >+ >+Turns the provided params into an XML document string. >+ >+=cut >+ >+sub output { >+ my $self = shift; >+ >+ my $str; >+ my $writer = XML::Writer->new(OUTPUT => \$str); >+ $writer->xmlDecl('UTF-8'); >+ $writer->startTag($self->{root}); >+ _add_to_xml($writer, $self->{data}); >+ $writer->endTag($self->{root}); >+ $writer->end(); >+ return $str; >+} >+ >+=head2 clear >+ >+ $xml->clear(); >+ >+This clears any in-progress data from the object so it can be used to create >+something new. Parameters are kept, it's just the data that goes away. >+ >+=cut >+ >+sub clear { >+ my $self = shift; >+ $self->{data} = {}; >+} >+ >+=head2 content_type >+ >+ my $ct = $xml->content_type(); >+ >+Returns a string containing the content type of the stuff that this class >+returns, suitable for passing to L<C4::JSONStream::output_with_http_headers>. >+In this case, it says 'xml'. >+ >+=cut >+ >+sub content_type { >+ return 'xml'; >+} >+ >+=head2 true >+ >+ my $true = $xml->true(); >+ >+This provides a 'true' value, as some format types need a special value. >+ >+=cut >+ >+sub true { >+ return '1'; >+} >+ >+ >+# This is an internal class sub that recurses through the provided data adding >+# each layer to the writer. >+sub _add_to_xml { >+ my ($writer, $data) = @_; >+ >+ my $r = ref $data; >+ >+ if ($r eq 'HASH') { >+ # data is a hashref >+ while (my ($k, $v) = each %$data) { >+ $writer->startTag($k); >+ _add_to_xml($writer, $v); >+ $writer->endTag($k); >+ } >+ } elsif ($r eq 'ARRAY') { >+ # data is an arrayref >+ $writer->startTag('array'); >+ foreach my $v (@$data) { >+ if (ref($v) eq 'HASH') { >+ # we don't say "item" for these ones >+ _add_to_xml($writer, $v); >+ } else { >+ $writer->startTag('item'); >+ _add_to_xml($writer, $v); >+ $writer->endTag('item'); >+ } >+ } >+ $writer->endTag('array'); >+ } elsif ($r eq '') { >+ # data is a scalar >+ $writer->characters($data); >+ } else { >+ confess "I got some data I can't handle: $data"; >+ } >+} >+ >+1; >+ >+=head1 AUTHORS >+ >+=over 4 >+ >+=item Robin Sheat <robin@catalyst.net.nz> >+ >+=back >+ >+=cut >diff --git a/C4/Service.pm b/C4/Service.pm >index d59cd70..a649c8c 100644 >--- a/C4/Service.pm >+++ b/C4/Service.pm >@@ -23,29 +23,32 @@ C4::Service - functions for JSON webservices. > > =head1 SYNOPSIS > >-my ( $query, $response) = C4::Service->init( { circulate => 1 } ); >-my ( $borrowernumber) = C4::Service->require_params( 'borrowernumber' ); >+my $response = C4::Output::XMLStream->new(...); >+my $service = C4::Service->new( { needed_flags => { circulate => 1 }, >+ [ output_stream => $response ], >+ [ query => CGI->new() ] } ); >+my ( $borrowernumber) = $service->require_params( 'borrowernumber' ); > >-C4::Service->return_error( 'internal', 'Frobnication failed', frobnicator => 'foo' ); >+$service->return_error( 'internal', 'Frobnication failed', frobnicator => 'foo' ); > > $response->param( frobnicated => 'You' ); > >-C4::Service->return_success( $response ); >+C4::Service->return_success(); > > =head1 DESCRIPTION > >-This module packages several useful functions for JSON webservices. >+This module packages several useful functions for webservices. > > =cut > > use strict; > use warnings; > >+use Carp; > use CGI qw ( -utf8 ); > use C4::Auth qw( check_api_auth ); > use C4::Output qw( :ajax ); > use C4::Output::JSONStream; >-use JSON; > > our $debug; > >@@ -53,42 +56,65 @@ BEGIN { > $debug = $ENV{DEBUG} || 0; > } > >-our ( $query, $cookie ); >- > =head1 METHODS > >-=head2 init >+=head2 new > >- our ( $query, $response ) = C4::Service->init( %needed_flags ); >+ my $service = C4::Service->new({needed_flags => { parameters => 1 }, >+ [ output_stream => C4::Output::XMLStream->new(...) ], >+ [ query => CGI->new() ]}); > >-Initialize the service and check for the permissions in C<%needed_flags>. >+Creates a new instance of C4::Service. It verifies that the provided flags >+are met by the current session, and aborts with an exit() call if they're >+not. It also accepts an instance of C4::Output::* (or something with the >+same interface) to use to generate the output. If none is provided, then >+a new instance of L<C4::Output::JSONStream> is created. Similarly, a query >+may also be provided. If it's not, a new CGI one will be created. > >-Also, check that the user is authorized and has a current session, and return an >-'auth' error if not. >+This call can't be used to log a user in by providing a userid parameter, it >+can only be used to check an already existing session. > >-init() returns a C<CGI> object and a C<C4::Output::JSONStream>. The latter can >-be used for both flat scripts and those that use dispatch(), and should be >-passed to C<return_success()>. >+TODO: exit sucks, make a better way. > > =cut > >-sub init { >- my ( $class, %needed_flags ) = @_; >+sub new { >+ my $class = shift; >+ >+ my %opts = %{shift()}; > >- our $query = new CGI; >+ my $needed_flags = $opts{needed_flags}; >+ croak "needed_flags is a required option" unless $needed_flags; > >- my ( $status, $cookie_, $sessionID ) = check_api_auth( $query, \%needed_flags ); >+ my $query = $opts{query} || CGI->new(); >+ # We capture the userid so it doesn't upset the auth check process >+ # (if we don't, the auth code will try to log in with the userid >+ # param value.) >+ my $userid; >+ $userid = $query->param('userid'); >+ $query->delete('userid') if defined($userid); > >- our $cookie = $cookie_; # I have no desire to offend the Perl scoping gods >+ my ( $status, $cookie, $sessionID ) = check_api_auth( $query, $needed_flags ); > >- $class->return_error( 'auth', $status ) if ( $status ne 'ok' ); >+ # Restore userid if needed >+ $query->param(-name=>'userid', -value=>$userid) if defined($userid); > >- return ( $query, new C4::Output::JSONStream ); >+ my $output_stream = $opts{output_stream} || C4::Output::JSONStream->new(); >+ my $self = { >+ needed_flags => $needed_flags, >+ query => $query, >+ output_stream => $output_stream, >+ cookie => $cookie, >+ }; >+ bless $self, $class; >+ $self->return_error('auth', $status) if ($status ne 'ok'); >+ >+ return $self; > } > > =head2 return_error > >- C4::Service->return_error( $type, $error, %flags ); >+ $service->return_error( $type, $error, %flags ); > > Exit the script with HTTP status 400, and return a JSON error object. > >@@ -106,20 +132,23 @@ param => value pairs. > =cut > > sub return_error { >- my ( $class, $type, $error, %flags ) = @_; >+ my ( $self, $type, $error, %flags ) = @_; > >- my $response = new C4::Output::JSONStream; >+ my $response = $self->{output_stream}; >+ $response->clear(); > > $response->param( message => $error ) if ( $error ); > $response->param( type => $type, %flags ); > >- output_with_http_headers $query, $cookie, $response->output, 'json', '400 Bad Request'; >+ output_with_http_headers $self->{query}, $self->{cookie}, $response->output, $response->content_type, '400 Bad Request'; >+ >+ # Someone please delete this > exit; > } > > =head2 return_multi > >- C4::Service->return_multi( \@responses, %flags ); >+ $service->return_multi( \@responses, %flags ); > > return_multi is similar to return_success or return_error, but allows you to > return different statuses for several requests sent at once (using HTTP status >@@ -139,12 +168,13 @@ structure verbatim. > =cut > > sub return_multi { >- my ( $class, $responses, @flags ) = @_; >+ my ( $self, $responses, @flags ) = @_; > >- my $response = new C4::Output::JSONStream; >+ my $response = $self->{output_stream}; >+ $response->clear(); > > if ( !@$responses ) { >- $class->return_success( $response ); >+ $self->return_success( $response ); > } else { > my @responses_formatted; > >@@ -152,14 +182,14 @@ sub return_multi { > if ( ref( $response ) eq 'ARRAY' ) { > my ($type, $error, @error_flags) = @$response; > >- push @responses_formatted, { is_error => JSON::true, type => $type, message => $error, @error_flags }; >+ push @responses_formatted, { is_error => $response->true(), type => $type, message => $error, @error_flags }; > } else { > push @responses_formatted, $response; > } > } > >- $response->param( 'multi' => JSON::true, responses => \@responses_formatted, @flags ); >- output_with_http_headers $query, $cookie, $response->output, 'json', '207 Multi-Status'; >+ $response->param( 'multi' => $response->true(), responses => \@responses_formatted, @flags ); >+ output_with_http_headers $self->{query}, $self->{cookie}, $response->output, $response->content_type, '207 Multi-Status'; > } > > exit; >@@ -167,22 +197,54 @@ sub return_multi { > > =head2 return_success > >- C4::Service->return_success( $response ); >+ $service->return_success(); > >-Print out the information in the C<C4::Output::JSONStream> C<$response>, then >-exit with HTTP status 200. >+Print out the information in the provided C<output_stream>, then >+exit with HTTP status 200. To get access to the C<output_stream>, you should >+either use the one that you provided, or you should use the C<output_stream()> >+accessor. > > =cut > > sub return_success { >- my ( $class, $response ) = @_; >+ my ( $self ) = @_; > >- output_with_http_headers $query, $cookie, $response->output, 'json'; >+ my $response = $self->{output_stream}; >+ output_with_http_headers $self->{query}, $self->{cookie}, $response->output, $response->content_type; >+} >+ >+=head2 output_stream >+ >+ $service->output_stream(); >+ >+Provides the output stream object that is in use so that data can be added >+to it. >+ >+=cut >+ >+sub output_stream { >+ my $self = shift; >+ >+ return $self->{output_stream}; >+} >+ >+=head2 query >+ >+ $service->query(); >+ >+Provides the query object that this class is using. >+ >+=cut >+ >+sub query { >+ my $self = shift; >+ >+ return $self->{query}; > } > > =head2 require_params > >- my @values = C4::Service->require_params( @params ); >+ my @values = $service->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. >@@ -192,13 +254,13 @@ If a required parameter is not found, send a 'param' error to the browser. > =cut > > sub require_params { >- my ( $class, @params ) = @_; >+ my ( $self, @params ) = @_; > > my @values; > > for my $param ( @params ) { >- $class->return_error( 'params', "Missing '$param'" ) if ( !defined( $query->param( $param ) ) ); >- push @values, $query->param( $param ); >+ $self->return_error( 'params', "Missing '$param'" ) if ( !defined( $self->{query}->param( $param ) ) ); >+ push @values, $self->{query}->param( $param ); > } > > return @values; >@@ -206,7 +268,7 @@ sub require_params { > > =head2 dispatch > >- C4::Service->dispatch( >+ $service->dispatch( > [ $path_regex, \@required_params, \&handler ], > ... > ); >@@ -233,8 +295,9 @@ with the argument '123'. > =cut > > sub dispatch { >- my $class = shift; >+ my $self = shift; > >+ my $query = $self->{query}; > my $path_info = $query->path_info || '/'; > > ROUTE: foreach my $route ( @_ ) { >@@ -251,7 +314,7 @@ sub dispatch { > return; > } > >- $class->return_error( 'no_handler', '' ); >+ $self->return_error( 'no_handler', '' ); > } > > 1; >@@ -263,3 +326,5 @@ __END__ > Koha Development Team > > Jesse Weaver <jesse.weaver@liblime.com> >+ >+Robin Sheat <robin@catalyst.net.nz> >diff --git a/Koha/Borrower/Search.pm b/Koha/Borrower/Search.pm >new file mode 100644 >index 0000000..0cf60ab >--- /dev/null >+++ b/Koha/Borrower/Search.pm >@@ -0,0 +1,149 @@ >+package Koha::Borrower::Search; >+ >+# Copyright 2015 Catalyst IT >+# >+# 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 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, write to the Free Software Foundation, Inc., >+# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. >+ >+use Modern::Perl; >+ >+use C4::Context; >+use Carp; >+ >+use base 'Exporter'; >+ >+our @EXPORT_OK = qw( find_borrower find_borrower_from_ext get_borrower_fields ); >+ >+=head1 NAME >+ >+Koha::Borrower::Search - a simple borrower searching interface >+ >+=head1 SYNOPSIS >+ >+ use Koha::Borrower::Search qw( find_borrower find_borrower_from_ext ); >+ # This will raise an exception if more than one borrower matches >+ my $borr_num = find_borrower('cardnumber', '123ABC'); >+ # This will give you a list of all the numbers >+ my @borr_nums = find_borrower('surname', 'Smith'); >+ >+ my $borr_num = find_borrower_from_ext('MEMBERNUM', '54321'); >+ my @borr_nums = find_borrower_from_ext('DEPARTMENT', 'Ministry of Silly Walks'); >+ >+=head1 DESCRIPTION >+ >+This provides some functions to find borrower records. >+ >+=head1 FUNCTIONS >+ >+=head2 find_borrower >+ >+ my $borr_num = find_borrower('cardnumber', '123ABC'); >+ my @borr_nums = find_borrower('surname', 'Smith'); >+ >+Given a column in the borrower table and a value, this will find matching >+borrowers. >+ >+If called in a scalar context, an exception will be raised if there is more >+than one result, or something else goes wrong, and C<undef> will be returned if >+there are no results. >+ >+If called in a list context, all borrowernumbers are returned. >+ >+=cut >+ >+sub find_borrower { >+ my ( $field, $value ) = @_; >+ >+ croak "Field value may not be safe for SQL" if $field =~ /[^A-Za-z0-9]/; >+ my $dbh = C4::Context->dbh(); >+ my $q = "SELECT borrowernumber FROM borrowers WHERE $field=?"; >+ my $sth = $dbh->prepare($q); >+ $sth->execute($value); >+ if (wantarray) { >+ my @bibs; >+ while (my $row = $sth->fetchrow_arrayref) { >+ push @bibs, $row->[0]; >+ } >+ return @bibs; >+ } else { >+ my $row = $sth->fetchrow_arrayref(); >+ return undef unless $row; >+ my $bib = $row->[0]; >+ die "Multiple borrowers match provided values\n" >+ if $sth->fetchrow_arrayref(); >+ return $bib; >+ } >+} >+ >+=head2 find_borrower_from_ext >+ >+ my $borr_num = find_borrower_from_ext('MEMBERNUM', '54321'); >+ my @borr_nums = find_borrower_from_ext('DEPARTMENT', 'Ministry of Silly Walks'); >+ >+Given the code for an extended borrower attribute, and a value, this will >+find the borrowers that match. >+ >+If called in a scalar context, an exception will be raised if there is more >+than one result, or something else goes wrong, and C<undef> will be returned if >+there are no results. >+ >+If called in a list context, all borrowernumbers are returned. >+ >+=cut >+ >+sub find_borrower_from_ext { >+ my ( $code, $value ) = @_; >+ >+ my $dbh = C4::Context->dbh(); >+ my $q = >+'SELECT DISTINCT borrowernumber FROM borrower_attributes WHERE code=? AND attribute=?'; >+ my $sth = $dbh->prepare($q); >+ $sth->execute( $code, $value ); >+ if (wantarray) { >+ my @bibs; >+ while (my $row = $sth->fetchrow_arrayref) { >+ push @bibs, $row->[0]; >+ } >+ return @bibs; >+ } else { >+ my $row = $sth->fetchrow_arrayref(); >+ return undef unless $row; >+ my $bib = $row->[0]; >+ die "Multiple borrowers match provided values\n" >+ if $sth->fetchrow_arrayref(); >+ return $bib; >+ } >+} >+ >+=head2 get_borrower_fields >+ >+Fetches the list of columns from the borrower table. Returns a list. >+ >+=cut >+ >+sub get_borrower_fields { >+ my $dbh = C4::Context->dbh(); >+ >+ my @fields; >+ my $q = 'SHOW COLUMNS FROM borrowers'; >+ my $sth = $dbh->prepare($q); >+ $sth->execute(); >+ while ( my $row = $sth->fetchrow_hashref() ) { >+ push @fields, $row->{Field}; >+ } >+ return @fields; >+} >+ >+1; >diff --git a/members/default_messageprefs.pl b/members/default_messageprefs.pl >index 2d70715..1b92772 100755 >--- a/members/default_messageprefs.pl >+++ b/members/default_messageprefs.pl >@@ -28,8 +28,9 @@ use C4::Form::MessagingPreferences; > # update the prefs if operator is creating a new patron and has > # changed the patron category from its original value. > >-my ($query, $response) = C4::Service->init(borrowers => 1); >+my $service = C4::Service->new({needed_flags => { borrowers => 1 }}); >+my $response = $service->output_stream(); > my ($categorycode) = C4::Service->require_params('categorycode'); > C4::Form::MessagingPreferences::set_form_values({ categorycode => $categorycode }, $response); >-C4::Service->return_success( $response ); >+C4::Service->return_success(); > >diff --git a/opac/sco/sco-patron-image.pl b/opac/sco/sco-patron-image.pl >index de8d8d6..b72cfb9 100755 >--- a/opac/sco/sco-patron-image.pl >+++ b/opac/sco/sco-patron-image.pl >@@ -22,7 +22,9 @@ use warnings; > use C4::Service; > use C4::Members; > >-my ($query, $response) = C4::Service->init(circulate => 'circulate_remaining_permissions'); >+my $service = C4::Service->init( >+ { needed_flags => { circulate => 'circulate_remaining_permissions' } } ); >+my $query = $service->query(); > > unless (C4::Context->preference('WebBasedSelfCheck')) { > print $query->header(status => '403 Forbidden - web-based self-check not enabled'); >@@ -33,7 +35,7 @@ unless (C4::Context->preference('ShowPatronImageInWebBasedSelfCheck')) { > exit; > } > >-my ($borrowernumber) = C4::Service->require_params('borrowernumber'); >+my ($borrowernumber) = $service->require_params('borrowernumber'); > > my ($imagedata, $dberror) = GetPatronImage($borrowernumber); > >diff --git a/svc/config/systempreferences b/svc/config/systempreferences >index deeca51..65901ee 100755 >--- a/svc/config/systempreferences >+++ b/svc/config/systempreferences >@@ -42,7 +42,7 @@ batches. > > =cut > >-our ( $query, $response ) = C4::Service->init( parameters => 1 ); >+our $service = C4::Service->new( { needed_flags => { parameters => 1 } } ); > > =head2 set_preference > >@@ -62,12 +62,12 @@ sub set_preference { > my ( $preference ) = @_; > > unless ( C4::Context->config('demo') ) { >- my $value = join( ',', $query->param( 'value' ) ); >+ my $value = join( ',', $service->query()->param( 'value' ) ); > C4::Context->set_preference( $preference, $value ); > logaction( 'SYSTEMPREFERENCE', 'MODIFY', undef, $preference . " | " . $value ); > } > >- C4::Service->return_success( $response ); >+ $service->return_success(); > } > > =head2 set_preferences >@@ -90,22 +90,22 @@ pref_virtualshelves=0 > > sub set_preferences { > unless ( C4::Context->config( 'demo' ) ) { >- foreach my $param ( $query->param() ) { >+ foreach my $param ( $service->query()->param() ) { > my ( $pref ) = ( $param =~ /pref_(.*)/ ); > > next if ( !defined( $pref ) ); > >- my $value = join( ',', $query->param( $param ) ); >+ my $value = join( ',', $service->query()->param( $param ) ); > > C4::Context->set_preference( $pref, $value ); > logaction( 'SYSTEMPREFERENCE', 'MODIFY', undef, $pref . " | " . $value ); > } > } > >- C4::Service->return_success( $response ); >+ $service->return_success(); > } > >-C4::Service->dispatch( >+$service->dispatch( > [ 'POST /([A-Za-z0-9_-]+)', [ 'value' ], \&set_preference ], > [ 'POST /', [], \&set_preferences ], > ); >diff --git a/svc/members/delete b/svc/members/delete >new file mode 100755 >index 0000000..1dce75f >--- /dev/null >+++ b/svc/members/delete >@@ -0,0 +1,154 @@ >+#!/usr/bin/perl >+ >+# Copyright 2015 Catalyst IT >+# >+# 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 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, write to the Free Software Foundation, Inc., >+# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. >+ >+=head1 NAME >+ >+svc/members/delete - web service for deleting a user >+ >+=head1 SYNOPSIS >+ >+ POST /svc/members/delete >+ >+The request parameters go in the POST body. >+ >+=head1 DESCRIPTION >+ >+This allows users to be deleted on a Koha system from another service. >+Information to match on is supplied as POST parameters, a user is searched for, >+and any matches are deleted. The field to search on may be an extended >+attribute code. >+ >+If any borrower that matches can't be deleted, for example it has charges >+owing or items on issue, then nothing will be deleted. >+ >+Deleted borrower records will be moved to the deletedborrowers table. >+ >+=head1 PARAMETERS >+ >+The request can accept a single parameter: >+ >+ fieldname=value >+ >+The fieldname is either a column in the C<borrowers> table, or the code of an >+extended attribute. >+ >+=head2 Results >+ >+On success, this will return a result in XML form containing a count of the >+records deleted. No records matching the search is also considered a success. >+ >+On failure, an error will be returned containing the borrower numbers that >+caused the operation to fail and the reason. >+ >+=cut >+ >+use Modern::Perl; >+ >+use C4::Context; >+use C4::Members; >+use C4::Output::XMLStream; >+use C4::Service; >+use C4::VirtualShelves (); #no import >+ >+use Koha::Borrower::Search qw( find_borrower find_borrower_from_ext get_borrower_fields ); >+ >+process_delete(); >+ >+sub process_delete { >+ my $xml = C4::Output::XMLStream->new(root => 'response'); >+ my $service = C4::Service->new( { needed_flags => { borrowers => 1 }, output_stream => $xml } ); >+ >+ my $query = $service->query(); >+ my @supplied_fields = $query->param(); >+ # We only allow one supplied field. >+ $service->return_error('parameters', 'Only one field to search for is permitted', status=>'failed') if @supplied_fields > 1; >+ $service->return_error('parameters', 'A field and value to match against must be provided', status=>'failed') unless @supplied_fields; >+ >+ my $fieldname = $supplied_fields[0]; >+ my $fieldvalue = $query->param($fieldname); >+ >+ # Figure out if we need to check the borrower fields or the extended attribs >+ my @borrower_fields = get_borrower_fields(); >+ my @attrib_types = get_extended_attribs(); >+ my $is_borrower_field = grep { $_ eq $fieldname } @borrower_fields; >+ if (!$is_borrower_field && !grep { $_ eq $fieldname} @attrib_types) { >+ $service->return_error('parameters', "Invalid parameter provided: $fieldname"); >+ } >+ >+ # Now find who this belongs to >+ my @borr_nums; >+ eval { >+ if ($is_borrower_field) { >+ @borr_nums = find_borrower($fieldname, $fieldvalue); >+ } else { >+ @borr_nums = find_borrower_from_ext($fieldname, $fieldvalue); >+ } >+ }; >+ if ($@) { >+ $service->return_error('searchfailed', $@, status=>'failed'); >+ } >+ unless (@borr_nums) { >+ # no results, automatic success >+ $service->output_stream->param(deletedcount => 0); >+ $service->output_stream->param(status => 'ok'); >+ $service->return_success(); >+ return; >+ } >+ >+ # Check for charges, issues >+ my (@borr_issues, @borr_charges); >+ foreach my $b (@borr_nums) { >+ my $issues = scalar @{ GetPendingIssues($b) }; >+ my ($borr_data) = GetMemberDetails($b, ''); >+ >+ push @borr_issues, $b if $issues; >+ push @borr_charges, $b if $borr_data->{flags}->{'CHARGES'}; >+ } >+ >+ if (@borr_issues || @borr_charges) { >+ $service->return_error( >+ 'constraints', 'Non-returned issues or uncleared charges', >+ status => 'failed', >+ issues => join( ',', @borr_issues ), >+ charges => join( ',', @borr_charges ) >+ ); >+ return; >+ } >+ >+ # All good, so let's delete >+ foreach my $b (@borr_nums) { >+ MoveMemberToDeleted($b); >+ C4::VirtualShelves::HandleDelBorrower($b); >+ DelMember($b); >+ } >+ $service->output_stream->param(deletedcount => scalar @borr_nums); >+ $service->output_stream->param(status => 'ok'); >+ $service->return_success(); >+} >+ >+=head2 get_extended_attribs >+ >+Fetch all the extended attributes from the system. Returns a list. >+ >+=cut >+ >+sub get_extended_attribs { >+ return map { $_->{code} } C4::Members::AttributeTypes::GetAttributeTypes(); >+} >+ >diff --git a/svc/members/upsert b/svc/members/upsert >new file mode 100755 >index 0000000..b826a8c >--- /dev/null >+++ b/svc/members/upsert >@@ -0,0 +1,317 @@ >+#!/usr/bin/perl >+ >+# Copyright 2015 Catalyst IT >+# >+# 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 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, write to the Free Software Foundation, Inc., >+# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. >+ >+=head1 NAME >+ >+svc/members/upsert - web service for inserting and updating user details >+ >+=head1 SYNOPSIS >+ >+ POST /svc/members/upsert >+ >+The request paramters go in the POST body. >+ >+=head1 DESCRIPTION >+ >+This allows user data to be added and updated on a Koha system from another >+service. User data is supplied, and if it matches an existing user, that user >+is updated. If not, then a new user is created. A field to match on must be >+provided. For example, this might be an ID of the user in an employee >+management system. It may be an extended attribute. >+ >+=head1 PARAMETERS >+ >+The request can contain any field from the borrowers table, and any extended >+attribute name. It must also contain 'matchField' which specifies the field >+to use to see if the user already exists. >+ >+To clear a field, provide an empty parameter for it. If the parameter doesn't >+exist, then the field will be left alone. >+ >+Dates must be in YYYY-MM-DD form. >+ >+Boolean values must be 1 (for true) or 0 (for false.) >+ >+A borrowernumber field may be provided and used for matching. It will be >+ignored when it comes to creating or updating however. >+ >+If the matchField parameters returns more than one value, an error will be >+raised. Care should be taken to ensure that it is unique. >+ >+=head2 Results >+ >+On success, this will return a result in XML form containing the >+borrowernumber of the record (whether it's newly created or just updated) and >+a 'createOrUpdate' element that contains either 'create' or 'update', >+depending on what operation ended up happening. >+ >+On error, an error response is returned. This may be because a matchField >+was provided that didn't match anything, or because the matchField >+produced multiple results. Or probably many other things. >+ >+=cut >+ >+use Modern::Perl; >+ >+use C4::Context; >+use C4::Members; >+use C4::Members::AttributeTypes; >+use C4::Output::XMLStream; >+use C4::Service; >+ >+use Koha::Borrower::Search >+ qw( find_borrower find_borrower_from_ext get_borrower_fields ); >+ >+process_upsert(); >+ >+sub process_upsert { >+ my $xml = C4::Output::XMLStream->new( root => 'response' ); >+ my $service = C4::Service->new( >+ { needed_flags => { borrowers => 1 }, output_stream => $xml } ); >+ >+ my $query = $service->query(); >+ my @supplied_fields = $query->param(); >+ my @borrower_fields = get_borrower_fields(); >+ my @attrib_types = get_extended_attribs(); >+ my $match_field = $query->param('matchField'); >+ >+ # Make a mapping of these so we can do fast lookups >+ my %borrower_fields = map { $_ => 1 } @borrower_fields; >+ my %attrib_types = map { $_ => 1 } @attrib_types; >+ >+ $service->return_error( >+ 'parameters', >+ 'No matchField provided', >+ status => 'failed' >+ ) unless $match_field; >+ my $is_borrower_field; # for matchField, as opposed to an ext attribute >+ $is_borrower_field = $borrower_fields{$match_field} // 0; >+ if ( !$is_borrower_field ) { >+ $service->return_error( >+ 'parameters', >+ 'Provided matchField doesn\'t match a valid field', >+ status => 'failed' >+ ) unless $attrib_types{$match_field}; >+ } >+ my $match_value = $query->param($match_field); >+ $service->return_error( >+ 'parameters', >+ 'The field specified by matchField wasn\'t provided.', >+ status => 'failed' >+ ) unless $match_value; >+ >+ # verify we are only given valid fields, at the same time make a mapping >+ # of them. >+ my ( %supplied_data_borr, %supplied_data_ext ); >+ foreach my $f (@supplied_fields) { >+ next if $f eq 'matchField'; >+ $service->return_error( 'parameters', "Invalid parameter provided: $f" ) >+ unless $borrower_fields{$f} || $attrib_types{$f}; >+ if ( $borrower_fields{$f} ) { >+ $supplied_data_borr{$f} = $query->param($f); >+ } >+ else { >+ $supplied_data_ext{$f} = $query->param($f); >+ } >+ } >+ >+ # Sanity checks and data extraction over, find our borrower. >+ my $borr_num; >+ eval { >+ if ($is_borrower_field) { >+ $borr_num = find_borrower( $match_field, $match_value ); >+ } >+ else { >+ $borr_num = find_borrower_from_ext( $match_field, $match_value ); >+ } >+ }; >+ if ($@) { >+ $service->return_error( 'borrower', $@, status => 'failed' ); >+ } >+ >+ # Now we know if we're creating a new user, or updating an existing one. >+ my $change_type; >+ eval { >+ if ($borr_num) { >+ update_borrower( $borr_num, \%supplied_data_borr, >+ \%supplied_data_ext ); >+ $change_type = 'update'; >+ } >+ else { >+ $borr_num = >+ create_borrower( \%supplied_data_borr, \%supplied_data_ext ); >+ $change_type = 'create'; >+ } >+ }; >+ if ($@) { >+ $service->return_error( 'data', $@, status => 'failed' ); >+ } >+ >+ $service->output_stream->param( 'borrowernumber', $borr_num ); >+ $service->output_stream->param( 'createOrUpdate', $change_type ); >+ $service->output_stream->param( 'status', 'ok' ); >+ $service->return_success(); >+} >+ >+=head2 get_extended_attribs >+ >+Fetch all the extended attributes from the system. Returns a list. >+ >+=cut >+ >+sub get_extended_attribs { >+ return map { $_->{code} } C4::Members::AttributeTypes::GetAttributeTypes(); >+} >+ >+=head2 update_borrower >+ >+ update_borrower($borr_num, \%borrower_fields, \%ext_attrib_fields); >+ >+This takes a borrower number, a hashref containing the fields and values for >+the borrower, and a hashref containing the fields and values for the extended >+attributes. It will update the borrower to set its fields to the values >+supplied. >+ >+A supplied borrowernumber will be ignored. >+ >+=cut >+ >+sub update_borrower { >+ my ( $borr_num, $borr_fields, $ext_fields ) = @_; >+ >+ # For the first phase, we build an update query for the borrower >+ my ( @f_borr, @v_borr ); >+ while ( my ( $f, $v ) = each %$borr_fields ) { >+ next if $f =~ /^borrowernumber$/i; >+ die "Invalid fieldname provided (update): $f\n" if $f =~ /[^A-Za-z0-9]/; >+ push @f_borr, $f; >+ push @v_borr, $v; >+ } >+ my $q_borr = >+ 'UPDATE borrowers SET ' >+ . ( join ',', map { $_ . '=?' } @f_borr ) >+ . ' WHERE borrowernumber=?'; >+ >+ # Now queries to sort out the extended fields >+ my @f_ext = keys %$ext_fields; >+ my @v_ext = values %$ext_fields; >+ my $q_ext_del = >+ 'DELETE FROM borrower_attributes WHERE borrowernumber=? AND code IN (' >+ . ( join ',', map { '?' } @f_ext ) . ')'; >+ my $q_ext_add = >+'INSERT INTO borrower_attributes (borrowernumber, code, attribute) VALUES (?, ?, ?)'; >+ >+ my $dbh = C4::Context->dbh(); >+ >+ # Finally, run these all inside a transaction. >+ eval { >+ local $dbh->{RaiseError} = 1; >+ $dbh->begin_work; >+ >+ my $sth; >+ >+ if (@f_borr) { >+ $sth = $dbh->prepare($q_borr); >+ $sth->execute( @v_borr, $borr_num ); >+ } >+ >+ $sth = $dbh->prepare($q_ext_del); >+ $sth->execute( $borr_num, @f_ext ) if @f_ext; >+ >+ $sth = $dbh->prepare($q_ext_add); >+ while ( my ( $f, $v ) = each %$ext_fields ) { >+ next if $v eq ''; >+ $sth->execute( $borr_num, $f, $v ); >+ } >+ >+ $dbh->commit; >+ }; >+ if ($@) { >+ $dbh->rollback; >+ die "Failed to update borrower record: $@\n"; >+ } >+ return $borr_num; >+} >+ >+=head2 create_borrower >+ >+ my $borr_num = create_borrower(\%borrower_fields, \%ext_attrib_fields); >+ >+This creates a new borrower using the supplied data. >+ >+A supplied borrowernumber will be ignored. >+ >+The borrowernumber of the new borrower will be returned. >+ >+=cut >+ >+sub create_borrower { >+ my ( $borr_fields, $ext_fields ) = @_; >+ >+ my @criticals = qw(surname branchcode categorycode); >+ >+ # Check we have the ones we need >+ foreach my $c (@criticals) { >+ die "Critical field missing (create): $c\n" unless $borr_fields->{$c}; >+ } >+ >+ # Borrower fields >+ my ( @f_borr, @v_borr ); >+ while ( my ( $f, $v ) = each %$borr_fields ) { >+ die "Invalid fieldname provided: $f\n" if $f =~ /[^A-Za-z0-9]/; >+ push @f_borr, $f; >+ push @v_borr, $v; >+ } >+ my $q_borr = >+ 'INSERT INTO borrowers (' >+ . ( join ',', @f_borr ) >+ . ') VALUES (' >+ . ( join ',', map { '?' } @f_borr ) . ')'; >+ >+ # Extended attributes >+ my @f_ext = keys %$ext_fields; >+ my @v_ext = values %$ext_fields; >+ my $q_ext_add = >+'INSERT INTO borrower_attributes (borrowernumber, code, attribute) VALUES (?, ?, ?)'; >+ >+ my $dbh = C4::Context->dbh(); >+ >+ # Finally, run these all inside a transaction. >+ my $borr_num; >+ eval { >+ local $dbh->{RaiseError} = 1; >+ $dbh->begin_work; >+ >+ my $sth = $dbh->prepare($q_borr); >+ $sth->execute(@v_borr); >+ $borr_num = $dbh->last_insert_id( undef, undef, undef, undef ); >+ >+ $sth = $dbh->prepare($q_ext_add); >+ while ( my ( $f, $v ) = each %$ext_fields ) { >+ $sth->execute( $borr_num, $f, $v ); >+ } >+ >+ $dbh->commit; >+ }; >+ if ($@) { >+ $dbh->rollback; >+ die "Failed to create borrower record: $@\n"; >+ } >+ return $borr_num; >+} >diff --git a/t/Output_JSONStream.t b/t/Output_JSONStream.t >index 13702a6..e4a8cfa 100755 >--- a/t/Output_JSONStream.t >+++ b/t/Output_JSONStream.t >@@ -6,7 +6,9 @@ > use strict; > use warnings; > >-use Test::More tests => 10; >+use Test::More tests => 12; >+ >+use JSON; > > BEGIN { > use_ok('C4::Output::JSONStream'); >@@ -30,3 +32,10 @@ eval{$json->param( die => ['yes','sure','now'])}; > ok(!$@,'Does not die.'); > eval{$json->param( die => ['yes','sure','now'], die2 =>)}; > ok($@,'Dies.'); >+ >+$json->clear(); >+is($json->output,'{}',"Making sure that clearing it clears it."); >+ >+is($json->content_type, 'json', 'Correct content type is returned'); >+ >+is($json->true, JSON::True, 'True is true.'); >diff --git a/t/Output_XMLStream.t b/t/Output_XMLStream.t >new file mode 100644 >index 0000000..c65ac48 >--- /dev/null >+++ b/t/Output_XMLStream.t >@@ -0,0 +1,70 @@ >+# Copyright 2014 Catalyst IT >+# >+# 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 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, write to the Free Software Foundation, Inc., >+# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. >+ >+use Modern::Perl; >+use Test::More tests => 15; >+ >+BEGIN { >+ use_ok('C4::Output::XMLStream'); >+} >+ >+my $xml = C4::Output::XMLStream->new(root => 'root'); >+ >+is(trim($xml->output), '<?xml version="1.0" encoding="UTF-8"?> >+<root></root> >+', 'Making sure that blank XML can be output'); >+ >+$xml->param( issues => [ 'yes!', 'please', 'no' ] ); >+is(trim($xml->output),'<?xml version="1.0" encoding="UTF-8"?> >+<root><issues><array><item>yes!</item><item>please</item><item>no</item></array></issues></root> >+',"Making sure XML output has added what we told it to."); >+ >+$xml->param( stuff => ['realia'] ); >+like($xml->output,qr|<stuff><array><item>realia</item></array></stuff>|,"Making sure XML output has added more params correctly."); >+like($xml->output,qr|<issues><array><item>yes!</item><item>please</item><item>no</item></array></issues>|,"Making sure the old data is still in there"); >+ >+$xml->param( stuff => ['fun','love'] ); >+like($xml->output,qr|<stuff><array><item>fun</item><item>love</item></array></stuff>|,"Making sure XML output can overwrite params"); >+like($xml->output,qr|<issues><array><item>yes!</item><item>please</item><item>no</item></array></issues>|,"Making sure the old data is still in there"); >+ >+$xml->param( halibut => { cod => 'bass' } ); >+like($xml->output,qr|<halibut><cod>bass</cod></halibut>|,"Adding of hashes works"); >+like($xml->output,qr|<issues><array><item>yes!</item><item>please</item><item>no</item></array></issues>|,"Making sure the old data is still in there"); >+ >+ >+eval{$xml->param( die )}; >+ok($@,'Dies'); >+ >+eval{$xml->param( die => ['yes','sure','now'])}; >+ok(!$@,'Dosent die.'); >+ >+eval{$xml->param( die => ['yes','sure','now'], die2 =>)}; >+ok($@,'Dies.'); >+ >+$xml->clear(); >+is(trim($xml->output), '<?xml version="1.0" encoding="UTF-8"?> >+<root></root> >+', 'Making sure that clearing it clears it.'); >+ >+is($xml->content_type, 'xml', 'Correct content type is returned'); >+ >+is($xml->true, '1', 'True is true.'); >+ >+sub trim { >+ $_ = shift; >+ s/^\s*(.*?)\s*$/$1/r; >+} >diff --git a/t/Service.t b/t/Service.t >new file mode 100755 >index 0000000..b3de535 >--- /dev/null >+++ b/t/Service.t >@@ -0,0 +1,71 @@ >+#!/usr/bin/perl >+ >+# Copyright 2015 Catalyst IT >+# >+# 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 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, write to the Free Software Foundation, Inc., >+# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. >+ >+use Modern::Perl; >+ >+use DBD::Mock; >+use Test::MockModule; >+ >+use Test::More tests => 3; >+ >+my $module_context = new Test::MockModule('C4::Context'); >+my $_dbh; >+$module_context->mock( >+ '_new_dbh', >+ sub { >+ my $dbh = $_dbh // DBI->connect('DBI:Mock:', '', '') || die "Cannot create handle: $DBI::errstr\n"; >+ $_dbh = $dbh; >+ return $dbh; >+ } >+); >+ >+# We need to mock the Auth process so that we can pretend we have a valid session >+my $module_auth = new Test::MockModule('C4::Auth'); >+$module_auth->mock( >+ 'check_api_auth', >+ sub { >+ return ('ok', '', ''); >+ } >+); >+ >+# Instead of actually outputting to stdout, we catch things on the way past >+my @_out_params; >+my $module_output = new Test::MockModule('C4::Output'); >+$module_output->mock( >+ 'output_with_http_headers', >+ sub { >+ @_out_params = @_; >+ } >+); >+ >+use_ok('C4::Output::XMLStream'); >+use_ok('C4::Service'); >+ >+# Do a simple round trip test of data in to data out >+my $xml_stream = C4::Output::XMLStream->new(root => 'test'); >+ >+my $service = C4::Service->new( { needed_flags => { borrowers => 1 } , >+ output_stream => $xml_stream }); >+ >+$service->output_stream->param( foo => 'bar' ); >+ >+$service->return_success(); >+like($_out_params[2], qr|<test><foo>bar</foo></test>|, 'XML output generated'); >+ >+ >diff --git a/t/db_dependent/Borrower_Search.t b/t/db_dependent/Borrower_Search.t >new file mode 100755 >index 0000000..322d954 >--- /dev/null >+++ b/t/db_dependent/Borrower_Search.t >@@ -0,0 +1,79 @@ >+#!/usr/bin/perl >+ >+# Copyright 2015 Catalyst IT >+# >+# 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 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, write to the Free Software Foundation, Inc., >+# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. >+ >+use C4::Context; >+ >+use Test::More tests => 10; >+ >+use_ok('Koha::Borrower::Search'); >+ >+my $dbh = C4::Context->dbh; >+$dbh->{RaiseError} = 1; >+$dbh->{AutoCommit} = 0; >+ >+# Insert some borrower detail to fetch later >+$dbh->do(q|INSERT INTO branches (branchcode) VALUES ('TBRANCH')|); >+$dbh->do(q|INSERT INTO categories (categorycode) VALUES ('TCAT')|); >+$dbh->do(q|INSERT INTO borrowers (borrowernumber,cardnumber,branchcode,categorycode,surname) VALUES (200000,'test123','TBRANCH','TCAT','Surname1'), (200001,'test124','TBRANCH','TCAT','Surname2'),(200002,'test125','TBRANCH','TCAT','Surname3')|); >+ >+# An ext attribute >+$dbh->do(q|INSERT INTO borrower_attribute_types (code, description) VALUES ('TEXTATTR', 'Test Ext Attrib')|); >+$dbh->do(q|INSERT INTO borrower_attributes (borrowernumber, code, attribute) VALUES (200000, 'TEXTATTR', 'TESTING')|); >+$dbh->do(q|INSERT INTO borrower_attributes (borrowernumber, code, attribute) VALUES (200001, 'TEXTATTR', 'TESTING')|); >+$dbh->do(q|INSERT INTO borrower_attributes (borrowernumber, code, attribute) VALUES (200002, 'TEXTATTR', 'TESTING2')|); >+ >+# And now the actual testing >+ >+# Check to make sure a couple of the columns come through. >+my @cols = Koha::Borrower::Search::get_borrower_fields(); >+ok((grep{$_ eq 'cardnumber'} @cols), 'Borrower field 1'); >+ok((grep{$_ eq 'lost'} @cols), 'Borrower field 2'); >+ok((grep{$_ eq 'userid'} @cols), 'Borrower field 3'); >+ >+# Find a borrower by a value >+my $num = Koha::Borrower::Search::find_borrower(surname => 'Surname2'); >+is($num, 200001, 'Fetch single borrower by field'); >+ >+my @nums = Koha::Borrower::Search::find_borrower(branchcode => 'TBRANCH'); >+is_deeply(\@nums, [200000, 200001, 200002], 'Fetch multiple borrowers by field'); >+ >+# Find by ext attr >+$num = Koha::Borrower::Search::find_borrower_from_ext(TEXTATTR => 'TESTING2'); >+is ($num, 200002, 'Fetch single borrower by ext attr'); >+ >+my @nums = Koha::Borrower::Search::find_borrower_from_ext(TEXTATTR => 'TESTING'); >+is_deeply(\@nums, [200000, 200001], 'Fetch multiple borrowers by ext attr'); >+ >+# Check that they correctly fail >+ >+my $fail = 1; >+eval { >+ $num = Koha::Borrower::Search::find_borrower(branchcode => 'TBRANCH'); >+ $fail = 0; >+}; >+is($fail, 1, 'Raised exception for multiple results by field'); >+ >+$fail = 1; >+eval { >+ $nums = Koha::Borrower::Search::find_borrower_from_ext(TEXTATTR => 'TESTING'); >+ $fail = 0; >+}; >+is($fail, 1, 'Raised exception for multiple results by ext attr'); >+ >+$dbh->rollback; >diff --git a/t/db_dependent/Service.t b/t/db_dependent/Service.t >deleted file mode 100755 >index 497cc1b..0000000 >--- a/t/db_dependent/Service.t >+++ /dev/null >@@ -1,14 +0,0 @@ >-#!/usr/bin/perl >-# >-# This Koha test module is a stub! >-# Add more tests here!!! >- >-use strict; >-use warnings; >- >-use Test::More tests => 1; >- >-BEGIN { >- use_ok('C4::Service'); >-} >- >-- >2.1.0
You cannot view the attachment while viewing its details because your browser does not support IFRAMEs.
View the attachment on a separate page
.
View Attachment As Diff
View Attachment As Raw
Actions:
View
|
Diff
|
Splinter Review
Attachments on
bug 13607
: 35455 |
35660
|
35737
|
36148
|
36356
|
37353