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;