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