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