(MT #3697) Fixed GetAuthorityRecords
[koha.git] / C4 / ILSDI / Services.pm
1 package C4::ILSDI::Services;
2
3 # Copyright 2009 SARL Biblibre
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 use strict;
21 use warnings;
22
23 use C4::Members;
24 use C4::Items;
25 use C4::Circulation;
26 use C4::Branch;
27 use C4::Accounts;
28 use C4::Biblio;
29 use C4::Reserves;
30 use C4::Context;
31 use C4::AuthoritiesMarc;
32 use C4::ILSDI::Utility;
33 use XML::Simple;
34 use HTML::Entities;
35 use CGI;
36
37 =head1 NAME
38
39 C4::ILS-DI::Services - ILS-DI Services
40
41 =head1 DESCRIPTION
42
43         Each function in this module represents an ILS-DI service.
44         They all takes a CGI instance as argument and most of them return a 
45         hashref that will be printed by XML::Simple in opac/ilsdi.pl
46
47 =head1 SYNOPSIS
48
49         use C4::ILSDI::Services;
50         use XML::Simple;
51         use CGI;
52
53         my $cgi = new CGI;
54
55         $out = LookupPatron($cgi);
56
57         print CGI::header('text/xml');
58         print XMLout($out,
59                 noattr => 1, 
60                 noescape => 1,
61                 nosort => 1,
62                 xmldecl => '<?xml version="1.0" encoding="ISO-8859-1" ?>', 
63                 RootName => 'LookupPatron', 
64                 SuppressEmpty => 1);
65
66 =cut
67
68 =head2 GetAvailability
69     
70         Given a set of biblionumbers or itemnumbers, returns a list with 
71         availability of the items associated with the identifiers.
72         
73         Parameters :
74
75         - id (Required)
76                 list of either biblionumbers or itemnumbers
77         - id_type (Required)
78                 defines the type of record identifier being used in the request, 
79                 possible values:
80                         - bib
81                         - item
82         - return_type (Optional)
83                 requests a particular level of detail in reporting availability, 
84                 possible values:
85                         - bib
86                         - item
87         - return_fmt (Optional)
88                 requests a particular format or set of formats in reporting 
89                 availability 
90
91 =cut
92
93 sub GetAvailability {
94     my ($cgi) = @_;
95
96     my $out = "<?xml version=\"1.0\" encoding=\"ISO-8859-1\" ?>\n";
97     $out .= "<dlf:collection\n";
98     $out .= "  xmlns:dlf=\"http://diglib.org/ilsdi/1.1\"\n";
99     $out .= "  xmlns:xsi=\"http://www.w3.org/2001/XMLSchema-instance\"\n";
100     $out .= "  xsi:schemaLocation=\"http://diglib.org/ilsdi/1.1\n";
101     $out .= "    http://diglib.org/architectures/ilsdi/schemas/1.1/dlfexpanded.xsd\">\n";
102
103     foreach my $id ( split( / /, $cgi->param('id') ) ) {
104         if ( $cgi->param('id_type') eq "item" ) {
105             my ( $biblionumber, $status, $msg, $location ) = Availability($id);
106
107             $out .= "  <dlf:record>\n";
108             $out .= "    <dlf:bibliographic id=\"" . ( $biblionumber || $id ) . "\" />\n";
109             $out .= "    <dlf:items>\n";
110             $out .= "      <dlf:item id=\"" . $id . "\">\n";
111             $out .= "        <dlf:simpleavailability>\n";
112             $out .= "          <dlf:identifier>" . $id . "</dlf:identifier>\n";
113             $out .= "          <dlf:availabilitystatus>" . $status . "</dlf:availabilitystatus>\n";
114             if ($msg)      { $out .= "          <dlf:availabilitymsg>" . $msg . "</dlf:availabilitymsg>\n"; }
115             if ($location) { $out .= "          <dlf:location>" . $location . "</dlf:location>\n"; }
116             $out .= "        </dlf:simpleavailability>\n";
117             $out .= "      </dlf:item>\n";
118             $out .= "    </dlf:items>\n";
119             $out .= "  </dlf:record>\n";
120         } else {
121             my $status;
122             my $msg;
123             my $biblioitem = ( GetBiblioItemByBiblioNumber( $id, undef ) )[0];
124             if ($biblioitem) {
125
126             } else {
127                 $status = "unknown";
128                 $msg    = "Error: could not retrieve availability for this ID";
129             }
130             $out .= "  <dlf:record>\n";
131             $out .= "    <dlf:bibliographic id=\"" . $id . "\" />\n";
132             $out .= "    <dlf:simpleavailability>\n";
133             $out .= "      <dlf:identifier>" . $id . "</dlf:identifier>\n";
134             $out .= "      <dlf:availabilitystatus>" . $status . "</dlf:availabilitystatus>\n";
135             $out .= "      <dlf:availabilitymsg>" . $msg . "</dlf:availabilitymsg>\n";
136             $out .= "    </dlf:simpleavailability>\n";
137             $out .= "  </dlf:record>\n";
138         }
139     }
140     $out .= "</dlf:collection>\n";
141
142     return $out;
143 }
144
145 =head2 GetRecords
146     
147         Given a list of biblionumbers, returns a list of record objects that 
148         contain bibliographic information, as well as associated holdings and item
149         information. The caller may request a specific metadata schema for the 
150         record objects to be returned.
151         This function behaves similarly to HarvestBibliographicRecords and 
152         HarvestExpandedRecords in Data Aggregation, but allows quick, real time 
153         lookup by bibliographic identifier.
154
155         You can use OAI-PMH ListRecords instead of this service.
156         
157         Parameters:
158
159         - id (Required)
160                 list of system record identifiers
161         - id_type (Optional)
162                 Defines the metadata schema in which the records are returned, 
163                 possible values:
164                         - MARCXML
165
166 =cut
167
168 sub GetRecords {
169     my ($cgi) = @_;
170
171     # Check if the schema is supported. For now, GetRecords only supports MARCXML
172     if ( $cgi->param('schema') and $cgi->param('schema') ne "MARCXML" ) {
173         return { code => 'UnsupportedSchema' };
174     }
175
176     my @records;
177
178     # Loop over biblionumbers
179     foreach my $biblionumber ( split( / /, $cgi->param('id') ) ) {
180
181         # Get the biblioitem from the biblionumber
182         my $biblioitem = ( GetBiblioItemByBiblioNumber( $biblionumber, undef ) )[0];
183         if ( not $biblioitem->{'biblionumber'} ) {
184             $biblioitem = "RecordNotFound";
185         }
186
187         # We don't want MARC to be displayed
188         delete $biblioitem->{'marc'};
189
190         # nor the XML declaration of MARCXML
191         $biblioitem->{'marcxml'} =~ s/<\?xml version="1.0" encoding="UTF-8"\?>//go;
192
193         # Get most of the needed data
194         my $biblioitemnumber = $biblioitem->{'biblioitemnumber'};
195         my @reserves         = GetReservesFromBiblionumber( $biblionumber, undef, undef );
196         my $issues           = GetBiblioIssues($biblionumber);
197         my $items            = GetItemsByBiblioitemnumber($biblioitemnumber);
198
199         # We loop over the items to clean them
200         foreach my $item (@$items) {
201
202             # This hides additionnal XML subfields, we don't need these info
203             delete $item->{'more_subfields_xml'};
204
205             # Display branch names instead of branch codes
206             $item->{'homebranchname'}    = GetBranchName( $item->{'homebranch'} );
207             $item->{'holdingbranchname'} = GetBranchName( $item->{'holdingbranch'} );
208         }
209
210         # Hashref building...
211         $biblioitem->{'items'}->{'item'}       = $items;
212         $biblioitem->{'reserves'}->{'reserve'} = $reserves[1];
213         $biblioitem->{'issues'}->{'issue'}     = $issues;
214
215         map { $biblioitem->{$_} = encode_entities( $biblioitem->{$_}, '&' ) } grep( !/marcxml/, keys %$biblioitem );
216         
217         push @records, $biblioitem;
218     }
219
220     return { record => \@records };
221 }
222
223 =head2 GetAuthorityRecords
224     
225         Given a list of authority record identifiers, returns a list of record 
226         objects that contain the authority records. The function user may request 
227         a specific metadata schema for the record objects.
228
229         Parameters:
230
231         - id (Required)
232             list of authority record identifiers
233         - schema (Optional)
234             specifies the metadata schema of records to be returned, possible values:
235                   - MARCXML
236
237 =cut
238
239 sub GetAuthorityRecords {
240     my ($cgi) = @_;
241
242     # If the user asks for an unsupported schema, return an error code
243     if ( $cgi->param('schema') and $cgi->param('schema') ne "MARCXML" ) {
244         return { code => 'UnsupportedSchema' };
245     }
246
247     my $records;
248
249     # Let's loop over the authority IDs
250     foreach my $authid ( split( / /, $cgi->param('id') ) ) {
251
252         # Get the record as XML string, or error code
253         my $record = GetAuthorityXML($authid) || "<record><code>RecordNotFound</code></record>";
254         $record =~ s/<\?xml(.*)\?>//go;
255         $records .= $record;
256     }
257
258     return $records;
259 }
260
261 =head2 LookupPatron
262     
263         Looks up a patron in the ILS by an identifier, and returns the borrowernumber.
264         
265         Parameters:
266
267         - id (Required)
268                 an identifier used to look up the patron in Koha
269         - id_type (Optional)
270                 the type of the identifier, possible values:
271                         - cardnumber
272                         - firstname
273                         - userid
274                         - borrowernumber
275
276 =cut
277
278 sub LookupPatron {
279     my ($cgi) = @_;
280
281     # Get the borrower...
282     my $borrower = GetMember($cgi->param('id_type') => $cgi->param('id'));
283     if ( not $borrower->{'borrowernumber'} ) {
284         return { message => 'PatronNotFound' };
285     }
286
287     # Build the hashref
288     my $patron->{'id'} = $borrower->{'borrowernumber'};
289     return { code => 'PatronNotFound' } unless $$borrower{borrowernumber};
290
291     # ...and return his ID
292     return $patron;
293 }
294
295 =head2 AuthenticatePatron
296
297         Authenticates a user's login credentials and returns the identifier for 
298         the patron.
299         
300         Parameters:
301
302         - username (Required)
303                 user's login identifier
304         - password (Required)
305                 user's password
306                 
307 =cut
308
309 sub AuthenticatePatron {
310     my ($cgi) = @_;
311
312     # Check if borrower exists, using a C4::Auth function...
313     unless( checkpw( C4::Context->dbh, $cgi->param('username'), $cgi->param('password') ) ) {
314         return { code => 'PatronNotFound' };
315     }
316
317     # Get the borrower
318     my $borrower = GetMember( userid => $cgi->param('username') );
319
320     # Build the hashref
321     my $patron->{'id'} = $borrower->{'borrowernumber'};
322
323     # ... and return his ID
324     return $patron;
325 }
326
327 =head2 GetPatronInfo
328
329         Returns specified information about the patron, based on options in the 
330         request. This function can optionally return patron's contact information, 
331         fine information, hold request information, and loan information.
332         
333         Parameters:
334
335         - patron_id (Required)
336                 the borrowernumber
337         - show_contact (Optional, default 1)
338                 whether or not to return patron's contact information in the response
339         - show_fines (Optional, default 0)
340                 whether or not to return fine information in the response
341         - show_holds (Optional, default 0)
342                 whether or not to return hold request information in the response
343         - show_loans (Optional, default 0)
344                 whether or not to return loan information request information in the response 
345                 
346 =cut
347
348 sub GetPatronInfo {
349     my ($cgi) = @_;
350
351     # Get Member details
352     my $borrowernumber = $cgi->param('patron_id');
353     my $borrower = GetMemberDetails( $borrowernumber );
354     return { code => 'PatronNotFound' } unless $$borrower{borrowernumber};
355
356     # Cleaning the borrower hashref
357     $borrower->{'charges'}    = $borrower->{'flags'}->{'CHARGES'}->{'amount'};
358     $borrower->{'branchname'} = GetBranchName( $borrower->{'branchcode'} );
359     delete $borrower->{'flags'};
360     delete $borrower->{'userid'};
361     delete $borrower->{'password'};
362
363     # Contact fields management
364     if ( $cgi->param('show_contact') eq "0" ) {
365
366         # Define contact fields
367         my @contactfields = (
368             'email',              'emailpro',           'fax',                 'mobile',          'phone',             'phonepro',
369             'streetnumber',       'zipcode',            'city',                'streettype',      'B_address',         'B_city',
370             'B_email',            'B_phone',            'B_zipcode',           'address',         'address2',          'altcontactaddress1',
371             'altcontactaddress2', 'altcontactaddress3', 'altcontactfirstname', 'altcontactphone', 'altcontactsurname', 'altcontactzipcode'
372         );
373
374         # and delete them
375         foreach my $field (@contactfields) {
376             delete $borrower->{$field};
377         }
378     }
379
380     # Fines management
381     if ( $cgi->param('show_fines') eq "1" ) {
382         my @charges;
383         for ( my $i = 1 ; my @charge = getcharges( $borrowernumber, undef, $i ) ; $i++ ) {
384             push( @charges, @charge );
385         }
386         $borrower->{'fines'}->{'fine'} = \@charges;
387     }
388
389     # Reserves management
390     if ( $cgi->param('show_holds') eq "1" ) {
391
392         # Get borrower's reserves
393         my @reserves = GetReservesFromBorrowernumber( $borrowernumber, undef );
394         foreach my $reserve (@reserves) {
395
396             # Get additional informations
397             my $item = GetBiblioFromItemNumber( $reserve->{'itemnumber'}, undef );
398             my $branchname = GetBranchName( $reserve->{'branchcode'} );
399
400             # Remove unwanted fields
401             delete $item->{'marc'};
402             delete $item->{'marcxml'};
403             delete $item->{'more_subfields_xml'};
404
405             # Add additional fields
406             $reserve->{'item'}       = $item;
407             $reserve->{'branchname'} = $branchname;
408             $reserve->{'title'}      = ( GetBiblio( $reserve->{'biblionumber'} ) )[1]->{'title'};
409         }
410         $borrower->{'holds'}->{'hold'} = \@reserves;
411     }
412
413     # Issues management
414     if ( $cgi->param('show_loans') eq "1" ) {
415         my $issues = GetPendingIssues($borrowernumber);
416         $borrower->{'loans'}->{'loan'} = $issues;
417     }
418
419     return $borrower;
420 }
421
422 =head2 GetPatronStatus
423
424         Returns a patron's status information.
425         
426         Parameters:
427
428         - patron_id (Required)
429                 the borrower ID
430
431 =cut
432
433 sub GetPatronStatus {
434     my ($cgi) = @_;
435
436     # Get Member details
437     my $borrowernumber = $cgi->param('patron_id');
438     my $borrower = GetMemberDetails( $borrowernumber );
439     return { code => 'PatronNotFound' } unless $$borrower{borrowernumber};
440
441     # Return the results
442     return {
443         type   => $$borrower{categorycode},
444         status => 0, # TODO
445         expiry => $$borrower{dateexpiry},
446     };
447 }
448
449 =head2 GetServices
450
451         Returns information about the services available on a particular item for 
452         a particular patron.
453         
454         Parameters:
455
456         - patron_id (Required)
457                 a borrowernumber
458         - item_id (Required)
459                 an itemnumber
460 =cut
461
462 sub GetServices {
463     my ($cgi) = @_;
464
465     # Get the member, or return an error code if not found
466     my $borrowernumber = $cgi->param('patron_id');
467     my $borrower = GetMemberDetails( $borrowernumber );
468     return { code => 'PatronNotFound' } unless $$borrower{borrowernumber};
469
470     # Get the item, or return an error code if not found
471     my $itemnumber = $cgi->param('item_id');
472     my $item = GetItem( $itemnumber );
473     return { code => 'RecordNotFound' } unless $$item{itemnumber};
474
475     my @availablefor;
476
477     # Reserve level management
478     my $biblionumber = $item->{'biblionumber'};
479     my $canbookbereserved = CanBookBeReserved( $borrower, $biblionumber );
480     if ($canbookbereserved) {
481         push @availablefor, 'title level hold';
482         my $canitembereserved = IsAvailableForItemLevelRequest($itemnumber);
483         if ($canitembereserved) {
484             push @availablefor, 'item level hold';
485         }
486     }
487
488     # Reserve cancellation management
489     my @reserves = GetReservesFromBorrowernumber( $borrowernumber, undef );
490     my @reserveditems;
491     foreach my $reserve (@reserves) {
492         push @reserveditems, $reserve->{'itemnumber'};
493     }
494     if ( grep { $itemnumber eq $_ } @reserveditems ) {
495         push @availablefor, 'hold cancellation';
496     }
497
498     # Renewal management
499     my @renewal = CanBookBeRenewed( $borrowernumber, $itemnumber );
500     if ( $renewal[0] ) {
501         push @availablefor, 'loan renewal';
502     }
503
504     # Issuing management
505     my $barcode = $item->{'barcode'} || '';
506     $barcode = barcodedecode($barcode) if ( $barcode && C4::Context->preference('itemBarcodeInputFilter') );
507     if ($barcode) {
508         my ( $issuingimpossible, $needsconfirmation ) = CanBookBeIssued( $borrower, $barcode );
509
510         # TODO push @availablefor, 'loan';
511     }
512
513     my $out;
514     $out->{'AvailableFor'} = \@availablefor;
515
516     return $out;
517 }
518
519 =head2 RenewLoan
520
521         Extends the due date for a borrower's existing issue.
522         
523         Parameters:
524
525         - patron_id (Required)
526                 a borrowernumber
527         - item_id (Required)
528                 an itemnumber
529         - desired_due_date (Required)
530                 the date the patron would like the item returned by 
531
532 =cut
533
534 sub RenewLoan {
535     my ($cgi) = @_;
536
537     # Get borrower infos or return an error code
538     my $borrowernumber = $cgi->param('patron_id');
539     my $borrower = GetMemberDetails( $borrowernumber );
540     return { code => 'PatronNotFound' } unless $$borrower{borrowernumber};
541
542     # Get the item, or return an error code
543     my $itemnumber = $cgi->param('item_id');
544     my $item = GetItem( $itemnumber );
545     return { code => 'RecordNotFound' } unless $$item{itemnumber};
546
547     # Add renewal if possible
548     my @renewal = CanBookBeRenewed( $borrowernumber, $itemnumber );
549     if ( $renewal[0] ) { AddRenewal( $borrowernumber, $itemnumber ); }
550
551     my $issue = GetItemIssue($itemnumber);
552
553     # Hashref building
554     my $out;
555     $out->{'renewals'} = $issue->{'renewals'};
556     $out->{'date_due'} = $issue->{'date_due'};
557     $out->{'success'}  = $renewal[0];
558     $out->{'error'}    = $renewal[1];
559
560     return $out;
561 }
562
563 =head2 HoldTitle
564
565         Creates, for a borrower, a biblio-level hold reserve.
566         
567         Parameters:
568
569         - patron_id (Required)
570                 a borrowernumber
571         - bib_id (Required)
572                 a biblionumber
573         - request_location (Required)
574                 IP address where the end user request is being placed
575         - pickup_location (Optional)
576                 a branch code indicating the location to which to deliver the item for pickup
577         - needed_before_date (Optional)
578                 date after which hold request is no longer needed
579         - pickup_expiry_date (Optional)
580                 date after which item returned to shelf if item is not picked up 
581
582 =cut
583
584 sub HoldTitle {
585     my ($cgi) = @_;
586
587     # Get the borrower or return an error code
588     my $borrowernumber = $cgi->param('patron_id');
589     my $borrower = GetMemberDetails( $borrowernumber );
590     return { code => 'PatronNotFound' } unless $$borrower{borrowernumber};
591
592     # Get the biblio record, or return an error code
593     my $biblionumber = $cgi->param('bib_id');
594     my ( $count, $biblio ) = GetBiblio( $biblionumber );
595     return { code => 'RecordNotFound' } unless $$biblio{biblionumber};
596     
597     my $title = $$biblio{title};
598
599     # Check if the biblio can be reserved
600     return { code => 'NotHoldable' } unless CanBookBeReserved( $borrowernumber, $biblionumber );
601
602     my $branch;
603
604     # Pickup branch management
605     if ( $cgi->param('pickup_location') ) {
606         $branch = $cgi->param('pickup_location');
607         my $branches = GetBranches;
608         return { code => 'LocationNotFound' } unless $$branches{$branch};
609     } else { # if the request provide no branch, use the borrower's branch
610         $branch = $$borrower{branchcode};
611     }
612
613     # Add the reserve
614     #          $branch, $borrowernumber, $biblionumber, $constraint, $bibitems,  $priority, $notes, $title, $checkitem,  $found
615     AddReserve( $branch, $borrowernumber, $biblionumber, 'a', undef, 0, undef, $title, undef, undef );
616
617     # Hashref building
618     my $out;
619     $out->{'title'}           = $title;
620     $out->{'pickup_location'} = GetBranchName($branch);
621
622     # TODO $out->{'date_available'}  = '';
623
624     return $out;
625 }
626
627 =head2 HoldItem
628
629         Creates, for a borrower, an item-level hold request on a specific item of 
630         a bibliographic record in Koha.
631
632         Parameters:
633
634         - patron_id (Required)
635                 a borrowernumber
636         - bib_id (Required)
637                 a biblionumber
638         - item_id (Required)
639                 an itemnumber
640         - pickup_location (Optional)
641                 a branch code indicating the location to which to deliver the item for pickup
642         - needed_before_date (Optional)
643                 date after which hold request is no longer needed
644         - pickup_expiry_date (Optional)
645                 date after which item returned to shelf if item is not picked up 
646
647 =cut
648
649 sub HoldItem {
650     my ($cgi) = @_;
651
652     # Get the borrower or return an error code
653     my $borrowernumber = $cgi->param('patron_id');
654     my $borrower = GetMemberDetails( $borrowernumber );
655     return { code => 'PatronNotFound' } unless $$borrower{borrowernumber};
656
657     # Get the biblio or return an error code
658     my $biblionumber = $cgi->param('bib_id');
659     my ( $count, $biblio ) = GetBiblio($biblionumber);
660     return { code => 'RecordNotFound' } unless $$biblio{biblionumber};
661
662     my $title = $$biblio{title};
663
664     # Get the item or return an error code
665     my $itemnumber = $cgi->param('item_id');
666     my $item = GetItem( $itemnumber );
667     return { code => 'RecordNotFound' } unless $$item{itemnumber};
668
669     # If the biblio does not match the item, return an error code
670     return { code => 'RecordNotFound' } if $$item{biblionumber} ne $$biblio{biblionumber};
671
672     # Check for item disponibility
673     my $canitembereserved = CanItemBeReserved( $borrowernumber, $itemnumber );
674     my $canbookbereserved = CanBookBeReserved( $borrowernumber, $biblionumber );
675     return { code => 'NotHoldable' } unless $canbookbereserved and $canitembereserved;
676
677     my $branch;
678
679     # Pickup branch management
680     if ( $cgi->param('pickup_location') ) {
681         $branch = $cgi->param('pickup_location');
682         my $branches = GetBranches();
683         return { code => 'LocationNotFound' } unless $$branches{$branch};
684     } else { # if the request provide no branch, use the borrower's branch
685         $branch = $$borrower{branchcode};
686     }
687
688     my $rank;
689     my $found;
690
691     # Get rank and found
692     $rank = '0' unless C4::Context->preference('ReservesNeedReturns');
693     if ( $item->{'holdingbranch'} eq $branch ) {
694         $found = 'W' unless C4::Context->preference('ReservesNeedReturns');
695     }
696
697     # Add the reserve
698     #          $branch, $borrowernumber, $biblionumber, $constraint, $bibitems,  $priority, $notes, $title, $checkitem,  $found
699     AddReserve( $branch, $borrowernumber, $biblionumber, 'a', undef, $rank, undef, $title, $itemnumber, $found );
700
701     # Hashref building
702     my $out;
703     $out->{'pickup_location'} = GetBranchName($branch);
704
705     # TODO $out->{'date_available'} = '';
706
707     return $out;
708 }
709
710 =head2 CancelHold
711
712         Cancels an active reserve request for the borrower.
713         
714         Parameters:
715
716         - patron_id (Required)
717                 a borrowernumber
718         - item_id (Required)
719                 an itemnumber 
720
721 =cut
722
723 sub CancelHold {
724     my ($cgi) = @_;
725
726     # Get the borrower or return an error code
727     my $borrowernumber = $cgi->param('patron_id');
728     my $borrower = GetMemberDetails( $borrowernumber );
729     return { code => 'PatronNotFound' } unless $$borrower{borrowernumber};
730
731     # Get the item or return an error code
732     my $itemnumber = $cgi->param('item_id');
733     my $item = GetItem( $itemnumber );
734     return { code => 'RecordNotFound' } unless $$item{itemnumber};
735
736     # Get borrower's reserves
737     my @reserves = GetReservesFromBorrowernumber( $borrowernumber, undef );
738     my @reserveditems;
739
740     # ...and loop over it to build an array of reserved itemnumbers
741     foreach my $reserve (@reserves) {
742         push @reserveditems, $reserve->{'itemnumber'};
743     }
744
745     # if the item was not reserved by the borrower, returns an error code
746     return { code => 'NotCanceled' } unless any { $itemnumber eq $_ } @reserveditems;
747
748     # Cancel the reserve
749     CancelReserve( $itemnumber, undef, $borrowernumber );
750
751     return { code => 'Canceled' };
752 }
753
754 1;