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