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