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