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