Bug 23985: (bug 21206 follow-up) Fix checkout list when "Hold pickup library match...
[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
8 # under the terms of the GNU General Public License as published by
9 # the Free Software Foundation; either version 3 of the License, or
10 # (at your option) any later version.
11 #
12 # Koha is distributed in the hope that it will be useful, but
13 # WITHOUT ANY WARRANTY; without even the implied warranty of
14 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 # GNU General Public License for more details.
16 #
17 # You should have received a copy of the GNU General Public License
18 # along with Koha; if not, see <http://www.gnu.org/licenses>.
19
20 use strict;
21 use warnings;
22
23 use C4::Members;
24 use C4::Items;
25 use C4::Circulation;
26 use C4::Accounts;
27 use C4::Biblio;
28 use C4::Reserves qw(AddReserve CanBookBeReserved CanItemBeReserved IsAvailableForItemLevelRequest);
29 use C4::Context;
30 use C4::AuthoritiesMarc;
31 use XML::Simple;
32 use HTML::Entities;
33 use CGI qw ( -utf8 );
34 use DateTime;
35 use C4::Auth;
36 use C4::Members::Attributes qw(GetBorrowerAttributes);
37 use Koha::DateUtils;
38
39 use Koha::Biblios;
40 use Koha::Checkouts;
41 use Koha::Items;
42 use Koha::Libraries;
43 use Koha::Patrons;
44
45 =head1 NAME
46
47 C4::ILS-DI::Services - ILS-DI Services
48
49 =head1 DESCRIPTION
50
51 Each function in this module represents an ILS-DI service.
52 They all takes a CGI instance as argument and most of them return a
53 hashref that will be printed by XML::Simple in opac/ilsdi.pl
54
55 =head1 SYNOPSIS
56
57     use C4::ILSDI::Services;
58     use XML::Simple;
59     use CGI qw ( -utf8 );
60
61     my $cgi = new CGI;
62
63     $out = LookupPatron($cgi);
64
65     print CGI::header('text/xml');
66     print XMLout($out,
67         noattr => 1,
68         noescape => 1,
69         nosort => 1,
70                 xmldecl => '<?xml version="1.0" encoding="UTF-8" ?>',
71         RootName => 'LookupPatron',
72         SuppressEmpty => 1);
73
74 =cut
75
76 =head1 FUNCTIONS
77
78 =head2 GetAvailability
79
80 Given a set of biblionumbers or itemnumbers, returns a list with
81 availability of the items associated with the identifiers.
82
83 Parameters:
84
85 =head3 id (Required)
86
87 list of either biblionumbers or itemnumbers
88
89 =head3 id_type (Required)
90
91 defines the type of record identifier being used in the request,
92 possible values:
93
94   - bib
95   - item
96
97 =head3 return_type (Optional)
98
99 requests a particular level of detail in reporting availability,
100 possible values:
101
102   - bib
103   - item
104
105 =head3 return_fmt (Optional)
106
107 requests a particular format or set of formats in reporting
108 availability
109
110 =cut
111
112 sub GetAvailability {
113     my ($cgi) = @_;
114
115     my $out = "<?xml version=\"1.0\" encoding=\"UTF-8\" ?>\n";
116     $out .= "<dlf:collection\n";
117     $out .= "  xmlns:dlf=\"http://diglib.org/ilsdi/1.1\"\n";
118     $out .= "  xmlns:xsi=\"http://www.w3.org/2001/XMLSchema-instance\"\n";
119     $out .= "  xsi:schemaLocation=\"http://diglib.org/ilsdi/1.1\n";
120     $out .= "    http://diglib.org/architectures/ilsdi/schemas/1.1/dlfexpanded.xsd\">\n";
121
122     foreach my $id ( split( / /, $cgi->param('id') ) ) {
123         if ( $cgi->param('id_type') eq "item" ) {
124             my ( $biblionumber, $status, $msg, $location ) = _availability($id);
125
126             $out .= "  <dlf:record>\n";
127             $out .= "    <dlf:bibliographic id=\"" . ( $biblionumber || $id ) . "\" />\n";
128             $out .= "    <dlf:items>\n";
129             $out .= "      <dlf:item id=\"" . $id . "\">\n";
130             $out .= "        <dlf:simpleavailability>\n";
131             $out .= "          <dlf:identifier>" . $id . "</dlf:identifier>\n";
132             $out .= "          <dlf:availabilitystatus>" . $status . "</dlf:availabilitystatus>\n";
133             if ($msg)      { $out .= "          <dlf:availabilitymsg>" . $msg . "</dlf:availabilitymsg>\n"; }
134             if ($location) { $out .= "          <dlf:location>" . $location . "</dlf:location>\n"; }
135             $out .= "        </dlf:simpleavailability>\n";
136             $out .= "      </dlf:item>\n";
137             $out .= "    </dlf:items>\n";
138             $out .= "  </dlf:record>\n";
139         } else {
140             my $status;
141             my $msg;
142             my $items = Koha::Items->search({ biblionumber => $id });
143             if ($items->count) {
144                 # Open XML
145                 $out .= "  <dlf:record>\n";
146                 $out .= "    <dlf:bibliographic id=\"" .$id. "\" />\n";
147                 $out .= "    <dlf:items>\n";
148                 # We loop over the items to clean them
149                 while ( my $item = $items->next ) {
150                     my $itemnumber = $item->itemnumber;
151                     my ( $biblionumber, $status, $msg, $location ) = _availability($itemnumber);
152                     $out .= "      <dlf:item id=\"" . $itemnumber . "\">\n";
153                     $out .= "        <dlf:simpleavailability>\n";
154                     $out .= "          <dlf:identifier>" . $itemnumber . "</dlf:identifier>\n";
155                     $out .= "          <dlf:availabilitystatus>" . $status . "</dlf:availabilitystatus>\n";
156                     if ($msg)      { $out .= "          <dlf:availabilitymsg>" . $msg . "</dlf:availabilitymsg>\n"; }
157                     if ($location) { $out .= "          <dlf:location>" . $location . "</dlf:location>\n"; }
158                     $out .= "        </dlf:simpleavailability>\n";
159                     $out .= "      </dlf:item>\n";
160                 }
161                 # Close XML
162                 $out .= "    </dlf:items>\n";
163                 $out .= "  </dlf:record>\n";
164             } else {
165                 $status = "unknown";
166                 $msg    = "Error: could not retrieve availability for this ID";
167             }
168         }
169     }
170     $out .= "</dlf:collection>\n";
171
172     return $out;
173 }
174
175 =head2 GetRecords
176
177 Given a list of biblionumbers, returns a list of record objects that
178 contain bibliographic information, as well as associated holdings and item
179 information. The caller may request a specific metadata schema for the
180 record objects to be returned.
181
182 This function behaves similarly to HarvestBibliographicRecords and
183 HarvestExpandedRecords in Data Aggregation, but allows quick, real time
184 lookup by bibliographic identifier.
185
186 You can use OAI-PMH ListRecords instead of this service.
187
188 Parameters:
189
190   - id (Required)
191     list of system record identifiers
192   - id_type (Optional)
193     Defines the metadata schema in which the records are returned,
194     possible values:
195         - MARCXML
196
197 =cut
198
199 sub GetRecords {
200     my ($cgi) = @_;
201
202     # Check if the schema is supported. For now, GetRecords only supports MARCXML
203     if ( $cgi->param('schema') and $cgi->param('schema') ne "MARCXML" ) {
204         return { code => 'UnsupportedSchema' };
205     }
206
207     my @records;
208
209     # Loop over biblionumbers
210     foreach my $biblionumber ( split( / /, $cgi->param('id') ) ) {
211
212         # Get the biblioitem from the biblionumber
213         my $biblio = Koha::Biblios->find( $biblionumber );
214         unless ( $biblio ) {
215             push @records, { code => "RecordNotFound" };
216             next;
217         }
218
219         my $biblioitem = $biblio->biblioitem->unblessed;
220
221         my $embed_items = 1;
222         my $record = GetMarcBiblio({
223             biblionumber => $biblionumber,
224             embed_items  => $embed_items });
225         if ($record) {
226             $biblioitem->{marcxml} = $record->as_xml_record();
227         }
228
229         # Get most of the needed data
230         my $biblioitemnumber = $biblioitem->{'biblioitemnumber'};
231         my $holds  = $biblio->current_holds->unblessed;
232         my $issues           = GetBiblioIssues($biblionumber);
233         my @items            = $biblio->items->as_list;
234
235         $biblioitem->{items}->{item} = [];
236
237         # We loop over the items to clean them
238         foreach my $item (@items) {
239             my %item = %{ $item->unblessed };
240
241             # This hides additionnal XML subfields, we don't need these info
242             delete $item{'more_subfields_xml'};
243
244             # Display branch names instead of branch codes
245             my $home_library    = $item->home_branch;
246             my $holding_library = $item->holding_branch;
247             $item{'homebranchname'}    = $home_library    ? $home_library->branchname    : '';
248             $item{'holdingbranchname'} = $holding_library ? $holding_library->branchname : '';
249
250             my $transfer = $item->get_transfer;
251             if ($transfer) {
252                 $item{transfer} = {
253                     datesent => $transfer->datesent,
254                     frombranch => $transfer->frombranch,
255                     tobranch => $transfer->tobranch,
256                 };
257             }
258
259             push @{ $biblioitem->{items}->{item} }, \%item;
260         }
261
262         # Hashref building...
263         $biblioitem->{'reserves'}->{'reserve'} = $holds;
264         $biblioitem->{'issues'}->{'issue'}     = $issues;
265
266         push @records, $biblioitem;
267     }
268
269     return { record => \@records };
270 }
271
272 =head2 GetAuthorityRecords
273
274 Given a list of authority record identifiers, returns a list of record
275 objects that contain the authority records. The function user may request
276 a specific metadata schema for the record objects.
277
278 Parameters:
279
280   - id (Required)
281     list of authority record identifiers
282   - schema (Optional)
283     specifies the metadata schema of records to be returned, possible values:
284       - MARCXML
285
286 =cut
287
288 sub GetAuthorityRecords {
289     my ($cgi) = @_;
290
291     # If the user asks for an unsupported schema, return an error code
292     if ( $cgi->param('schema') and $cgi->param('schema') ne "MARCXML" ) {
293         return { code => 'UnsupportedSchema' };
294     }
295
296     my @records;
297
298     # Let's loop over the authority IDs
299     foreach my $authid ( split( / /, $cgi->param('id') ) ) {
300
301         # Get the record as XML string, or error code
302         push @records, GetAuthorityXML($authid) || { code => 'RecordNotFound' };
303     }
304
305     return { record => \@records };
306 }
307
308 =head2 LookupPatron
309
310 Looks up a patron in the ILS by an identifier, and returns the borrowernumber.
311
312 Parameters:
313
314   - id (Required)
315     an identifier used to look up the patron in Koha
316   - id_type (Optional)
317     the type of the identifier, possible values:
318     - cardnumber
319     - userid
320         - email
321     - borrowernumber
322     - firstname
323         - surname
324
325 =cut
326
327 sub LookupPatron {
328     my ($cgi) = @_;
329
330     my $id      = $cgi->param('id');
331     if(!$id) {
332         return { message => 'PatronNotFound' };
333     }
334
335     my $patrons;
336     my $passed_id_type = $cgi->param('id_type');
337     if($passed_id_type) {
338         $patrons = Koha::Patrons->search( { $passed_id_type => $id } );
339     } else {
340         foreach my $id_type ('cardnumber', 'userid', 'email', 'borrowernumber',
341                      'surname', 'firstname') {
342             $patrons = Koha::Patrons->search( { $id_type => $id } );
343             last if($patrons->count);
344         }
345     }
346     unless ( $patrons->count ) {
347         return { message => 'PatronNotFound' };
348     }
349
350     return { id => $patrons->next->borrowernumber };
351 }
352
353 =head2 AuthenticatePatron
354
355 Authenticates a user's login credentials and returns the identifier for
356 the patron.
357
358 Parameters:
359
360   - username (Required)
361     user's login identifier (userid or cardnumber)
362   - password (Required)
363     user's password
364
365 =cut
366
367 sub AuthenticatePatron {
368     my ($cgi) = @_;
369     my $username = $cgi->param('username');
370     my $password = $cgi->param('password');
371     my ($status, $cardnumber, $userid) = C4::Auth::checkpw( C4::Context->dbh, $username, $password );
372     if ( $status ) {
373         # Get the borrower
374         my $patron = Koha::Patrons->find( { userid => $userid } );
375         return { id => $patron->borrowernumber };
376     }
377     else {
378         return { code => 'PatronNotFound' };
379     }
380 }
381
382 =head2 GetPatronInfo
383
384 Returns specified information about the patron, based on options in the
385 request. This function can optionally return patron's contact information,
386 fine information, hold request information, and loan information.
387
388 Parameters:
389
390   - patron_id (Required)
391     the borrowernumber
392   - show_contact (Optional, default 1)
393     whether or not to return patron's contact information in the response
394   - show_fines (Optional, default 0)
395     whether or not to return fine information in the response
396   - show_holds (Optional, default 0)
397     whether or not to return hold request information in the response
398   - show_loans (Optional, default 0)
399     whether or not to return loan information request information in the response
400   - show_attributes (Optional, default 0)
401     whether or not to return additional patron attributes, when enabled the attributes
402     are limited to those marked as opac visible only.
403
404 =cut
405
406 sub GetPatronInfo {
407     my ($cgi) = @_;
408
409     # Get Member details
410     my $borrowernumber = $cgi->param('patron_id');
411     my $patron = Koha::Patrons->find( $borrowernumber );
412     return { code => 'PatronNotFound' } unless $patron;
413
414     # Cleaning the borrower hashref
415     my $borrower = $patron->unblessed;
416     $borrower->{charges} = sprintf "%.02f", $patron->account->non_issues_charges; # FIXME Formatting should not be done here
417     my $library = Koha::Libraries->find( $borrower->{branchcode} );
418     $borrower->{'branchname'} = $library ? $library->branchname : '';
419     delete $borrower->{'userid'};
420     delete $borrower->{'password'};
421
422     # Contact fields management
423     if ( defined $cgi->param('show_contact') && $cgi->param('show_contact') eq "0" ) {
424
425         # Define contact fields
426         my @contactfields = (
427             'email',              'emailpro',           'fax',                 'mobile',          'phone',             'phonepro',
428             'streetnumber',       'zipcode',            'city',                'streettype',      'B_address',         'B_city',
429             'B_email',            'B_phone',            'B_zipcode',           'address',         'address2',          'altcontactaddress1',
430             'altcontactaddress2', 'altcontactaddress3', 'altcontactfirstname', 'altcontactphone', 'altcontactsurname', 'altcontactzipcode'
431         );
432
433         # and delete them
434         foreach my $field (@contactfields) {
435             delete $borrower->{$field};
436         }
437     }
438
439     # Fines management
440     if ( $cgi->param('show_fines') && $cgi->param('show_fines') eq "1" ) {
441         $borrower->{fines}{fine} = $patron->account->lines->unblessed;
442     }
443
444     # Reserves management
445     if ( $cgi->param('show_holds') && $cgi->param('show_holds') eq "1" ) {
446
447         # Get borrower's reserves
448         my $holds = $patron->holds;
449         while ( my $hold = $holds->next ) {
450
451             my ( $item, $biblio, $biblioitem ) = ( {}, {}, {} );
452             # Get additional informations
453             if ( $hold->itemnumber ) {    # item level holds
454                 $item       = Koha::Items->find( $hold->itemnumber );
455                 $biblio     = $item->biblio;
456                 $biblioitem = $biblio->biblioitem;
457
458                 # Remove unwanted fields
459                 $item = $item->unblessed;
460                 delete $item->{more_subfields_xml};
461                 $biblio     = $biblio->unblessed;
462                 $biblioitem = $biblioitem->unblessed;
463             }
464
465             # Add additional fields
466             my $unblessed_hold = $hold->unblessed;
467             $unblessed_hold->{item}       = { %$item, %$biblio, %$biblioitem };
468             my $library = Koha::Libraries->find( $hold->branchcode );
469             my $branchname = $library ? $library->branchname : '';
470             $unblessed_hold->{branchname} = $branchname;
471             $biblio = Koha::Biblios->find( $hold->biblionumber ); # Should be $hold->get_biblio
472             $unblessed_hold->{title} = $biblio ? $biblio->title : ''; # Just in case, but should not be needed
473
474             push @{ $borrower->{holds}{hold} }, $unblessed_hold;
475
476         }
477     }
478
479     # Issues management
480     if ( $cgi->param('show_loans') && $cgi->param('show_loans') eq "1" ) {
481         my $per_page = $cgi->param('loans_per_page');
482         my $page = $cgi->param('loans_page');
483
484         my $pending_checkouts = $patron->pending_checkouts;
485
486         if ($page || $per_page) {
487             $page ||= 1;
488             $per_page ||= 10;
489             $borrower->{total_loans} = $pending_checkouts->count();
490             $pending_checkouts = $pending_checkouts->search(undef, {
491                 rows => $per_page,
492                 page => $page,
493             });
494         }
495
496         my @checkouts;
497         while ( my $c = $pending_checkouts->next ) {
498             # FIXME We should only retrieve what is needed in the template
499             my $issue = $c->unblessed_all_relateds;
500             delete $issue->{'more_subfields_xml'};
501             push @checkouts, $issue
502         }
503         $borrower->{'loans'}->{'loan'} = \@checkouts;
504     }
505
506     my $show_attributes = $cgi->param('show_attributes');
507     if ( $show_attributes && $show_attributes eq "1" ) {
508         my $attrs = GetBorrowerAttributes( $borrowernumber, 1 );
509         $borrower->{'attributes'} = $attrs;
510     }
511
512     # Add is expired information
513     $borrower->{'is_expired'} = $patron->is_expired ? 1 : 0;
514
515     return $borrower;
516 }
517
518 =head2 GetPatronStatus
519
520 Returns a patron's status information.
521
522 Parameters:
523
524   - patron_id (Required)
525     the borrower ID
526
527 =cut
528
529 sub GetPatronStatus {
530     my ($cgi) = @_;
531
532     # Get Member details
533     my $borrowernumber = $cgi->param('patron_id');
534     my $patron = Koha::Patrons->find( $borrowernumber );
535     return { code => 'PatronNotFound' } unless $patron;
536
537     # Return the results
538     return {
539         type   => $patron->categorycode,
540         status => 0, # TODO
541         expiry => $patron->dateexpiry,
542     };
543 }
544
545 =head2 GetServices
546
547 Returns information about the services available on a particular item for
548 a particular patron.
549
550 Parameters:
551
552   - patron_id (Required)
553     a borrowernumber
554   - item_id (Required)
555     an itemnumber
556
557 =cut
558
559 sub GetServices {
560     my ($cgi) = @_;
561
562     # Get the member, or return an error code if not found
563     my $borrowernumber = $cgi->param('patron_id');
564     my $patron = Koha::Patrons->find( $borrowernumber );
565     return { code => 'PatronNotFound' } unless $patron;
566
567     my $borrower = $patron->unblessed;
568     # Get the item, or return an error code if not found
569     my $itemnumber = $cgi->param('item_id');
570     my $item = Koha::Items->find($itemnumber);
571     return { code => 'RecordNotFound' } unless $item;
572
573     my @availablefor;
574
575     # Reserve level management
576     my $biblionumber = $item->biblionumber;
577     my $canbookbereserved = CanBookBeReserved( $borrower, $biblionumber );
578     if ($canbookbereserved->{status} eq 'OK') {
579         push @availablefor, 'title level hold';
580         my $canitembereserved = IsAvailableForItemLevelRequest($item, $patron);
581         if ($canitembereserved) {
582             push @availablefor, 'item level hold';
583         }
584     }
585
586     # Reserve cancellation management
587     my $holds = $patron->holds;
588     my @reserveditems;
589     while ( my $hold = $holds->next ) { # FIXME This could be improved
590         push @reserveditems, $hold->itemnumber;
591     }
592     if ( grep { $itemnumber eq $_ } @reserveditems ) {
593         push @availablefor, 'hold cancellation';
594     }
595
596     # Renewal management
597     my @renewal = CanBookBeRenewed( $borrowernumber, $itemnumber );
598     if ( $renewal[0] ) {
599         push @availablefor, 'loan renewal';
600     }
601
602     # Issuing management
603     my $barcode = $item->barcode || '';
604     $barcode = barcodedecode($barcode) if ( $barcode && C4::Context->preference('itemBarcodeInputFilter') );
605     if ($barcode) {
606         my ( $issuingimpossible, $needsconfirmation ) = CanBookBeIssued( $patron, $barcode );
607
608         # TODO push @availablefor, 'loan';
609     }
610
611     my $out;
612     $out->{'AvailableFor'} = \@availablefor;
613
614     return $out;
615 }
616
617 =head2 RenewLoan
618
619 Extends the due date for a borrower's existing issue.
620
621 Parameters:
622
623   - patron_id (Required)
624     a borrowernumber
625   - item_id (Required)
626     an itemnumber
627   - desired_due_date (Required)
628     the date the patron would like the item returned by
629
630 =cut
631
632 sub RenewLoan {
633     my ($cgi) = @_;
634
635     # Get borrower infos or return an error code
636     my $borrowernumber = $cgi->param('patron_id');
637     my $patron = Koha::Patrons->find( $borrowernumber );
638     return { code => 'PatronNotFound' } unless $patron;
639
640     # Get the item, or return an error code
641     my $itemnumber = $cgi->param('item_id');
642     my $item = Koha::Items->find($itemnumber);
643     return { code => 'RecordNotFound' } unless $item;
644
645     # Add renewal if possible
646     my @renewal = CanBookBeRenewed( $borrowernumber, $itemnumber );
647     if ( $renewal[0] ) { AddRenewal( $borrowernumber, $itemnumber ); }
648
649     my $issue = $item->checkout;
650     return unless $issue; # FIXME should be handled
651
652     # Hashref building
653     my $out;
654     $out->{'renewals'} = $issue->renewals;
655     $out->{date_due}   = dt_from_string($issue->date_due)->strftime('%Y-%m-%d %H:%M');
656     $out->{'success'}  = $renewal[0];
657     $out->{'error'}    = $renewal[1];
658
659     return $out;
660 }
661
662 =head2 HoldTitle
663
664 Creates, for a borrower, a biblio-level hold reserve.
665
666 Parameters:
667
668   - patron_id (Required)
669     a borrowernumber
670   - bib_id (Required)
671     a biblionumber
672   - request_location (Required)
673     IP address where the end user request is being placed
674   - pickup_location (Optional)
675     a branch code indicating the location to which to deliver the item for pickup
676   - needed_before_date (Optional)
677     date after which hold request is no longer needed
678   - pickup_expiry_date (Optional)
679     date after which item returned to shelf if item is not picked up
680
681 =cut
682
683 sub HoldTitle {
684     my ($cgi) = @_;
685
686     # Get the borrower or return an error code
687     my $borrowernumber = $cgi->param('patron_id');
688     my $patron = Koha::Patrons->find( $borrowernumber );
689     return { code => 'PatronNotFound' } unless $patron;
690
691     # If borrower is restricted return an error code
692     return { code => 'PatronRestricted' } if $patron->is_debarred;
693
694     # Get the biblio record, or return an error code
695     my $biblionumber = $cgi->param('bib_id');
696     my $biblio = Koha::Biblios->find( $biblionumber );
697     return { code => 'RecordNotFound' } unless $biblio;
698
699     my @hostitems = get_hostitemnumbers_of($biblionumber);
700     my @itemnumbers;
701     if (@hostitems){
702         push(@itemnumbers, @hostitems);
703     }
704
705     my $items = Koha::Items->search({ -or => { biblionumber => $biblionumber, itemnumber => { in => \@itemnumbers } } });
706
707     unless ( $items->count ) {
708         return { code => 'NoItems' };
709     }
710
711     my $title = $biblio ? $biblio->title : '';
712
713     # Check if the biblio can be reserved
714     my $code = CanBookBeReserved( $borrowernumber, $biblionumber )->{status};
715     return { code => $code } unless ( $code eq 'OK' );
716
717     my $branch;
718
719     # Pickup branch management
720     if ( $cgi->param('pickup_location') ) {
721         $branch = $cgi->param('pickup_location');
722         return { code => 'LocationNotFound' } unless Koha::Libraries->find($branch);
723     } else { # if the request provide no branch, use the borrower's branch
724         $branch = $patron->branchcode;
725     }
726
727     my $destination = Koha::Libraries->find($branch);
728     return { code => 'libraryNotPickupLocation' } unless $destination->pickup_location;
729     return { code => 'cannotBeTransferred' } unless $biblio->can_be_transferred({ to => $destination });
730
731     # Add the reserve
732     #    $branch,    $borrowernumber, $biblionumber,
733     #    $constraint, $bibitems,  $priority, $resdate, $expdate, $notes,
734     #    $title,      $checkitem, $found
735     my $priority= C4::Reserves::CalculatePriority( $biblionumber );
736     AddReserve( $branch, $borrowernumber, $biblionumber, undef, $priority, undef, undef, undef, $title, undef, undef );
737
738     # Hashref building
739     my $out;
740     $out->{'title'}           = $title;
741     my $library = Koha::Libraries->find( $branch );
742     $out->{'pickup_location'} = $library ? $library->branchname : '';
743
744     # TODO $out->{'date_available'}  = '';
745
746     return $out;
747 }
748
749 =head2 HoldItem
750
751 Creates, for a borrower, an item-level hold request on a specific item of
752 a bibliographic record in Koha.
753
754 Parameters:
755
756   - patron_id (Required)
757     a borrowernumber
758   - bib_id (Required)
759     a biblionumber
760   - item_id (Required)
761     an itemnumber
762   - pickup_location (Optional)
763     a branch code indicating the location to which to deliver the item for pickup
764   - needed_before_date (Optional)
765     date after which hold request is no longer needed
766   - pickup_expiry_date (Optional)
767     date after which item returned to shelf if item is not picked up
768
769 =cut
770
771 sub HoldItem {
772     my ($cgi) = @_;
773
774     # Get the borrower or return an error code
775     my $borrowernumber = $cgi->param('patron_id');
776     my $patron = Koha::Patrons->find( $borrowernumber );
777     return { code => 'PatronNotFound' } unless $patron;
778
779     # If borrower is restricted return an error code
780     return { code => 'PatronRestricted' } if $patron->is_debarred;
781
782     # Get the biblio or return an error code
783     my $biblionumber = $cgi->param('bib_id');
784     my $biblio = Koha::Biblios->find( $biblionumber );
785     return { code => 'RecordNotFound' } unless $biblio;
786
787     my $title = $biblio ? $biblio->title : '';
788
789     # Get the item or return an error code
790     my $itemnumber = $cgi->param('item_id');
791     my $item = Koha::Items->find($itemnumber);
792     return { code => 'RecordNotFound' } unless $item;
793
794     # If the biblio does not match the item, return an error code
795     return { code => 'RecordNotFound' } if $item->biblionumber ne $biblio->biblionumber;
796
797     # Pickup branch management
798     my $branch;
799     if ( $cgi->param('pickup_location') ) {
800         $branch = $cgi->param('pickup_location');
801         return { code => 'LocationNotFound' } unless Koha::Libraries->find($branch);
802     } else { # if the request provide no branch, use the borrower's branch
803         $branch = $patron->branchcode;
804     }
805
806     # Check for item disponibility
807     my $canitembereserved = C4::Reserves::CanItemBeReserved( $borrowernumber, $itemnumber, $branch )->{status};
808     return { code => $canitembereserved } unless $canitembereserved eq 'OK';
809
810     # Add the reserve
811     #    $branch,    $borrowernumber, $biblionumber,
812     #    $constraint, $bibitems,  $priority, $resdate, $expdate, $notes,
813     #    $title,      $checkitem, $found
814     my $priority= C4::Reserves::CalculatePriority( $biblionumber );
815     AddReserve( $branch, $borrowernumber, $biblionumber, undef, $priority, undef, undef, undef, $title, $itemnumber, undef );
816
817     # Hashref building
818     my $out;
819     my $library = Koha::Libraries->find( $branch );
820     $out->{'pickup_location'} = $library ? $library->branchname : '';
821
822     # TODO $out->{'date_available'} = '';
823
824     return $out;
825 }
826
827 =head2 CancelHold
828
829 Cancels an active reserve request for the borrower.
830
831 Parameters:
832
833   - patron_id (Required)
834         a borrowernumber
835   - item_id (Required)
836         a reserve_id
837
838 =cut
839
840 sub CancelHold {
841     my ($cgi) = @_;
842
843     # Get the borrower or return an error code
844     my $borrowernumber = $cgi->param('patron_id');
845     my $patron = Koha::Patrons->find( $borrowernumber );
846     return { code => 'PatronNotFound' } unless $patron;
847
848     # Get the reserve or return an error code
849     my $reserve_id = $cgi->param('item_id');
850     my $hold = Koha::Holds->find( $reserve_id );
851     return { code => 'RecordNotFound' } unless $hold;
852     return { code => 'RecordNotFound' } unless ($hold->borrowernumber == $borrowernumber);
853
854     $hold->cancel;
855
856     return { code => 'Canceled' };
857 }
858
859 =head2 _availability
860
861 Returns, for an itemnumber, an array containing availability information.
862
863  my ($biblionumber, $status, $msg, $location) = _availability($id);
864
865 =cut
866
867 sub _availability {
868     my ($itemnumber) = @_;
869     my $item = Koha::Items->find($itemnumber);
870
871     unless ( $item ) {
872         return ( undef, 'unknown', 'Error: could not retrieve availability for this ID', undef );
873     }
874
875     my $biblionumber = $item->biblioitemnumber;
876     my $library = Koha::Libraries->find( $item->holdingbranch );
877     my $location = $library ? $library->branchname : '';
878
879     if ( $item->notforloan ) {
880         return ( $biblionumber, 'not available', 'Not for loan', $location );
881     } elsif ( $item->onloan ) {
882         return ( $biblionumber, 'not available', 'Checked out', $location );
883     } elsif ( $item->itemlost ) {
884         return ( $biblionumber, 'not available', 'Item lost', $location );
885     } elsif ( $item->withdrawn ) {
886         return ( $biblionumber, 'not available', 'Item withdrawn', $location );
887     } elsif ( $item->damaged ) {
888         return ( $biblionumber, 'not available', 'Item damaged', $location );
889     } else {
890         return ( $biblionumber, 'available', undef, $location );
891     }
892 }
893
894 1;