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