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