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;
  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         if ( $cgi->param('id_type') eq "item" ) {
 105             my ( $biblionumber, $status, $msg, $location ) = Availability($id);
 106
 107             $out .= "  <dlf:record>\n";
 108             $out .= "    <dlf:bibliographic id=\"" . ( $biblionumber || $id ) . "\" />\n";
 109             $out .= "    <dlf:items>\n";
 110             $out .= "      <dlf:item id=\"" . $id . "\">\n";
 111             $out .= "        <dlf:simpleavailability>\n";
 112             $out .= "          <dlf:identifier>" . $id . "</dlf:identifier>\n";
 113             $out .= "          <dlf:availabilitystatus>" . $status . "</dlf:availabilitystatus>\n";
 114             if ($msg)      { $out .= "          <dlf:availabilitymsg>" . $msg . "</dlf:availabilitymsg>\n"; }
 115             if ($location) { $out .= "          <dlf:location>" . $location . "</dlf:location>\n"; }
 116             $out .= "        </dlf:simpleavailability>\n";
 117             $out .= "      </dlf:item>\n";
 118             $out .= "    </dlf:items>\n";
 119             $out .= "  </dlf:record>\n";
 120         } else {
 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         return { code => 'UnsupportedSchema' };
 174     }
 175
 176     my @records;
 177
 178     # Loop over biblionumbers
 179     foreach my $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
 190         # nor the XML declaration of MARCXML
 191         $biblioitem->{'marcxml'} =~ s/<\?xml version="1.0" encoding="UTF-8"\?>//go;
 192
 193         # Get most of the needed data
 194         my $biblioitemnumber = $biblioitem->{'biblioitemnumber'};
 195         my @reserves         = GetReservesFromBiblionumber( $biblionumber, undef, undef );
 196         my $issues           = GetBiblioIssues($biblionumber);
 197         my $items            = GetItemsByBiblioitemnumber($biblioitemnumber);
 198
 199         # We loop over the items to clean them
 200         foreach my $item (@$items) {
 201
 202             # This hides additionnal XML subfields, we don't need these info
 203             delete $item->{'more_subfields_xml'};
 204
 205             # Display branch names instead of branch codes
 206             $item->{'homebranchname'}    = GetBranchName( $item->{'homebranch'} );
 207             $item->{'holdingbranchname'} = GetBranchName( $item->{'holdingbranch'} );
 208         }
 209
 210         # Hashref building...
 211         $biblioitem->{'items'}->{'item'}       = $items;
 212         $biblioitem->{'reserves'}->{'reserve'} = $reserves[1];
 213         $biblioitem->{'issues'}->{'issue'}     = $issues;
 214
 215         map { $biblioitem->{$_} = encode_entities( $biblioitem->{$_}, '&' ) } grep( !/marcxml/, keys %$biblioitem );
 216
 217     }
 218
 219     return { record => \@records };
 220 }
 221
 222 =head2 GetAuthorityRecords
 223
 224         Given a list of authority record identifiers, returns a list of record
 225         objects that contain the authority records. The function user may request
 226         a specific metadata schema for the record objects.
 227
 228         Parameters:
 229
 230         - id (Required)
 231             list of authority record identifiers
 232         - schema (Optional)
 233             specifies the metadata schema of records to be returned, possible values:
 234                   - MARCXML
 235
 236 =cut
 237
 238 sub GetAuthorityRecords {
 239     my ($cgi) = @_;
 240
 241     # If the user asks for an unsupported schema, return an error code
 242     if ( $cgi->param('schema') and $cgi->param('schema') ne "MARCXML" ) {
 243         return { code => 'UnsupportedSchema' };
 244     }
 245
 246     my $records;
 247
 248     # Let's loop over the authority IDs
 249     foreach my $authid ( split( / /, $cgi->param('id') ) ) {
 250
 251         # Get the record as XML string, or error code
 252         my $record = GetAuthorityXML( $_ ) || "<record><code>RecordNotFound</code></record>";
 253         $record =~ s/<\?xml(.*)\?>//go;
 254         $records .= $record;
 255     }
 256
 257     return $records;
 258 }
 259
 260 =head2 LookupPatron
 261
 262         Looks up a patron in the ILS by an identifier, and returns the borrowernumber.
 263
 264         Parameters:
 265
 266         - id (Required)
 267                 an identifier used to look up the patron in Koha
 268         - id_type (Optional)
 269                 the type of the identifier, possible values:
 270                         - cardnumber
 271                         - firstname
 272                         - userid
 273                         - borrowernumber
 274
 275 =cut
 276
 277 sub LookupPatron {
 278     my ($cgi) = @_;
 279
 280     # Get the borrower...
 281     my $borrower = GetMember($cgi->param('id_type') => $cgi->param('id'));
 282     if ( not $borrower->{'borrowernumber'} ) {
 283         return { message => 'PatronNotFound' };
 284     }
 285
 286     # Build the hashref
 287     my $patron->{'id'} = $borrower->{'borrowernumber'};
 288     return { code => 'PatronNotFound' } unless $$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::Auth function...
 312     unless( checkpw( C4::Context->dbh, $cgi->param('username'), $cgi->param('password') ) ) {
 313         return { code => 'PatronNotFound' };
 314     }
 315
 316     # Get the borrower
 317     my $borrower = GetMember( userid => $cgi->param('username') );
 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 );
 353     return { code => 'PatronNotFound' } unless $$borrower{borrowernumber};
 354
 355     # Cleaning the borrower hashref
 356     $borrower->{'charges'}    = $borrower->{'flags'}->{'CHARGES'}->{'amount'};
 357     $borrower->{'branchname'} = GetBranchName( $borrower->{'branchcode'} );
 358     delete $borrower->{'flags'};
 359     delete $borrower->{'userid'};
 360     delete $borrower->{'password'};
 361
 362     # Contact fields management
 363     if ( $cgi->param('show_contact') eq "0" ) {
 364
 365         # Define contact fields
 366         my @contactfields = (
 367             'email',              'emailpro',           'fax',                 'mobile',          'phone',             'phonepro',
 368             'streetnumber',       'zipcode',            'city',                'streettype',      'B_address',         'B_city',
 369             'B_email',            'B_phone',            'B_zipcode',           'address',         'address2',          'altcontactaddress1',
 370             'altcontactaddress2', 'altcontactaddress3', 'altcontactfirstname', 'altcontactphone', 'altcontactsurname', 'altcontactzipcode'
 371         );
 372
 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
 391         # Get borrower's reserves
 392         my @reserves = GetReservesFromBorrowernumber( $borrowernumber, undef );
 393         foreach my $reserve (@reserves) {
 394
 395             # Get additional informations
 396             my $item = GetBiblioFromItemNumber( $reserve->{'itemnumber'}, undef );
 397             my $branchname = GetBranchName( $reserve->{'branchcode'} );
 398
 399             # Remove unwanted fields
 400             delete $item->{'marc'};
 401             delete $item->{'marcxml'};
 402             delete $item->{'more_subfields_xml'};
 403
 404             # Add additional fields
 405             $reserve->{'item'}       = $item;
 406             $reserve->{'branchname'} = $branchname;
 407             $reserve->{'title'}      = ( GetBiblio( $reserve->{'biblionumber'} ) )[1]->{'title'};
 408         }
 409         $borrower->{'holds'}->{'hold'} = \@reserves;
 410     }
 411
 412     # Issues management
 413     if ( $cgi->param('show_loans') eq "1" ) {
 414         my $issues = GetPendingIssues($borrowernumber);
 415         $borrower->{'loans'}->{'loan'} = $issues;
 416     }
 417
 418     return $borrower;
 419 }
 420
 421 =head2 GetPatronStatus
 422
 423         Returns a patron's status information.
 424
 425         Parameters:
 426
 427         - patron_id (Required)
 428                 the borrower ID
 429
 430 =cut
 431
 432 sub GetPatronStatus {
 433     my ($cgi) = @_;
 434
 435     # Get Member details
 436     my $borrowernumber = $cgi->param('patron_id');
 437     my $borrower = GetMemberDetails( $borrowernumber );
 438     return { code => 'PatronNotFound' } unless $$borrower{borrowernumber};
 439
 440     # Return the results
 441     return {
 442         type   => $$borrower{categorycode},
 443         status => 0, # TODO
 444         expiry => $$borrower{dateexpiry},
 445     };
 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 );
 467     return { code => 'PatronNotFound' } unless $$borrower{borrowernumber};
 468
 469     # Get the item, or return an error code if not found
 470     my $itemnumber = $cgi->param('item_id');
 471     my $item = GetItem( $itemnumber );
 472     return { code => 'RecordNotFound' } unless $$item{itemnumber};
 473
 474     my @availablefor;
 475
 476     # Reserve level management
 477     my $biblionumber = $item->{'biblionumber'};
 478     my $canbookbereserved = CanBookBeReserved( $borrower, $biblionumber );
 479     if ($canbookbereserved) {
 480         push @availablefor, 'title level hold';
 481         my $canitembereserved = IsAvailableForItemLevelRequest($itemnumber);
 482         if ($canitembereserved) {
 483             push @availablefor, 'item level hold';
 484         }
 485     }
 486
 487     # Reserve cancellation management
 488     my @reserves = GetReservesFromBorrowernumber( $borrowernumber, undef );
 489     my @reserveditems;
 490     foreach my $reserve (@reserves) {
 491         push @reserveditems, $reserve->{'itemnumber'};
 492     }
 493     if ( grep { $itemnumber eq $_ } @reserveditems ) {
 494         push @availablefor, 'hold cancellation';
 495     }
 496
 497     # Renewal management
 498     my @renewal = CanBookBeRenewed( $borrowernumber, $itemnumber );
 499     if ( $renewal[0] ) {
 500         push @availablefor, 'loan renewal';
 501     }
 502
 503     # Issuing management
 504     my $barcode = $item->{'barcode'} || '';
 505     $barcode = barcodedecode($barcode) if ( $barcode && C4::Context->preference('itemBarcodeInputFilter') );
 506     if ($barcode) {
 507         my ( $issuingimpossible, $needsconfirmation ) = CanBookBeIssued( $borrower, $barcode );
 508
 509         # TODO push @availablefor, 'loan';
 510     }
 511
 512     my $out;
 513     $out->{'AvailableFor'} = \@availablefor;
 514
 515     return $out;
 516 }
 517
 518 =head2 RenewLoan
 519
 520         Extends the due date for a borrower's existing issue.
 521
 522         Parameters:
 523
 524         - patron_id (Required)
 525                 a borrowernumber
 526         - item_id (Required)
 527                 an itemnumber
 528         - desired_due_date (Required)
 529                 the date the patron would like the item returned by
 530
 531 =cut
 532
 533 sub RenewLoan {
 534     my ($cgi) = @_;
 535
 536     # Get borrower infos or return an error code
 537     my $borrowernumber = $cgi->param('patron_id');
 538     my $borrower = GetMemberDetails( $borrowernumber );
 539     return { code => 'PatronNotFound' } unless $$borrower{borrowernumber};
 540
 541     # Get the item, or return an error code
 542     my $itemnumber = $cgi->param('item_id');
 543     my $item = GetItem( $itemnumber );
 544     return { code => 'RecordNotFound' } unless $$item{itemnumber};
 545
 546     # Add renewal if possible
 547     my @renewal = CanBookBeRenewed( $borrowernumber, $itemnumber );
 548     if ( $renewal[0] ) { AddRenewal( $borrowernumber, $itemnumber ); }
 549
 550     my $issue = GetItemIssue($itemnumber);
 551
 552     # Hashref building
 553     my $out;
 554     $out->{'renewals'} = $issue->{'renewals'};
 555     $out->{'date_due'} = $issue->{'date_due'};
 556     $out->{'success'}  = $renewal[0];
 557     $out->{'error'}    = $renewal[1];
 558
 559     return $out;
 560 }
 561
 562 =head2 HoldTitle
 563
 564         Creates, for a borrower, a biblio-level hold reserve.
 565
 566         Parameters:
 567
 568         - patron_id (Required)
 569                 a borrowernumber
 570         - bib_id (Required)
 571                 a biblionumber
 572         - request_location (Required)
 573                 IP address where the end user request is being placed
 574         - pickup_location (Optional)
 575                 a branch code indicating the location to which to deliver the item for pickup
 576         - needed_before_date (Optional)
 577                 date after which hold request is no longer needed
 578         - pickup_expiry_date (Optional)
 579                 date after which item returned to shelf if item is not picked up
 580
 581 =cut
 582
 583 sub HoldTitle {
 584     my ($cgi) = @_;
 585
 586     # Get the borrower or return an error code
 587     my $borrowernumber = $cgi->param('patron_id');
 588     my $borrower = GetMemberDetails( $borrowernumber );
 589     return { code => 'PatronNotFound' } unless $$borrower{borrowernumber};
 590
 591     # Get the biblio record, or return an error code
 592     my $biblionumber = $cgi->param('bib_id');
 593     my ( $count, $biblio ) = GetBiblio( $biblionumber );
 594     return { code => 'RecordNotFound' } unless $$biblio{biblionumber};
 595
 596     my $title = $$biblio{title};
 597
 598     # Check if the biblio can be reserved
 599     return { code => 'NotHoldable' } unless CanBookBeReserved( $borrowernumber, $biblionumber );
 600
 601     my $branch;
 602
 603     # Pickup branch management
 604     if ( $cgi->param('pickup_location') ) {
 605         $branch = $cgi->param('pickup_location');
 606         my $branches = GetBranches;
 607         return { code => 'LocationNotFound' } unless $$branches{$branch};
 608     } else { # if the request provide no branch, use the borrower's branch
 609         $branch = $$borrower{branchcode};
 610     }
 611
 612     # Add the reserve
 613     #          $branch, $borrowernumber, $biblionumber, $constraint, $bibitems,  $priority, $notes, $title, $checkitem,  $found
 614     AddReserve( $branch, $borrowernumber, $biblionumber, 'a', undef, 0, undef, $title, undef, undef );
 615
 616     # Hashref building
 617     my $out;
 618     $out->{'title'}           = $title;
 619     $out->{'pickup_location'} = GetBranchName($branch);
 620
 621     # TODO $out->{'date_available'}  = '';
 622
 623     return $out;
 624 }
 625
 626 =head2 HoldItem
 627
 628         Creates, for a borrower, an item-level hold request on a specific item of
 629         a bibliographic record in Koha.
 630
 631         Parameters:
 632
 633         - patron_id (Required)
 634                 a borrowernumber
 635         - bib_id (Required)
 636                 a biblionumber
 637         - item_id (Required)
 638                 an itemnumber
 639         - pickup_location (Optional)
 640                 a branch code indicating the location to which to deliver the item for pickup
 641         - needed_before_date (Optional)
 642                 date after which hold request is no longer needed
 643         - pickup_expiry_date (Optional)
 644                 date after which item returned to shelf if item is not picked up
 645
 646 =cut
 647
 648 sub HoldItem {
 649     my ($cgi) = @_;
 650
 651     # Get the borrower or return an error code
 652     my $borrowernumber = $cgi->param('patron_id');
 653     my $borrower = GetMemberDetails( $borrowernumber );
 654     return { code => 'PatronNotFound' } unless $$borrower{borrowernumber};
 655
 656     # Get the biblio or return an error code
 657     my $biblionumber = $cgi->param('bib_id');
 658     my ( $count, $biblio ) = GetBiblio($biblionumber);
 659     return { code => 'RecordNotFound' } unless $$biblio{biblionumber};
 660
 661     my $title = $$biblio{title};
 662
 663     # Get the item or return an error code
 664     my $itemnumber = $cgi->param('item_id');
 665     my $item = GetItem( $itemnumber );
 666     return { code => 'RecordNotFound' } unless $$item{itemnumber};
 667
 668     # If the biblio does not match the item, return an error code
 669     return { code => 'RecordNotFound' } if $$item{biblionumber} ne $$biblio{biblionumber};
 670
 671     # Check for item disponibility
 672     my $canitembereserved = CanItemBeReserved( $borrowernumber, $itemnumber );
 673     my $canbookbereserved = CanBookBeReserved( $borrowernumber, $biblionumber );
 674     return { code => 'NotHoldable' } unless $canbookbereserved and $canitembereserved;
 675
 676     my $branch;
 677
 678     # Pickup branch management
 679     if ( $cgi->param('pickup_location') ) {
 680         $branch = $cgi->param('pickup_location');
 681         my $branches = GetBranches();
 682         return { code => 'LocationNotFound' } unless $$branches{$branch};
 683     } else { # if the request provide no branch, use the borrower's branch
 684         $branch = $$borrower{branchcode};
 685     }
 686
 687     my $rank;
 688     my $found;
 689
 690     # Get rank and found
 691     $rank = '0' unless C4::Context->preference('ReservesNeedReturns');
 692     if ( $item->{'holdingbranch'} eq $branch ) {
 693         $found = 'W' unless C4::Context->preference('ReservesNeedReturns');
 694     }
 695
 696     # Add the reserve
 697     #          $branch, $borrowernumber, $biblionumber, $constraint, $bibitems,  $priority, $notes, $title, $checkitem,  $found
 698     AddReserve( $branch, $borrowernumber, $biblionumber, 'a', undef, $rank, undef, $title, $itemnumber, $found );
 699
 700     # Hashref building
 701     my $out;
 702     $out->{'pickup_location'} = GetBranchName($branch);
 703
 704     # TODO $out->{'date_available'} = '';
 705
 706     return $out;
 707 }
 708
 709 =head2 CancelHold
 710
 711         Cancels an active reserve request for the borrower.
 712
 713         Parameters:
 714
 715         - patron_id (Required)
 716                 a borrowernumber
 717         - item_id (Required)
 718                 an itemnumber
 719
 720 =cut
 721
 722 sub CancelHold {
 723     my ($cgi) = @_;
 724
 725     # Get the borrower or return an error code
 726     my $borrowernumber = $cgi->param('patron_id');
 727     my $borrower = GetMemberDetails( $borrowernumber );
 728     return { code => 'PatronNotFound' } unless $$borrower{borrowernumber};
 729
 730     # Get the item or return an error code
 731     my $itemnumber = $cgi->param('item_id');
 732     my $item = GetItem( $itemnumber );
 733     return { code => 'RecordNotFound' } unless $$item{itemnumber};
 734
 735     # Get borrower's reserves
 736     my @reserves = GetReservesFromBorrowernumber( $borrowernumber, undef );
 737     my @reserveditems;
 738
 739     # ...and loop over it to build an array of reserved itemnumbers
 740     foreach my $reserve (@reserves) {
 741         push @reserveditems, $reserve->{'itemnumber'};
 742     }
 743
 744     # if the item was not reserved by the borrower, returns an error code
 745     return { code => 'NotCanceled' } unless any { $itemnumber eq $_ } @reserveditems;
 746
 747     # Cancel the reserve
 748     CancelReserve( $itemnumber, undef, $borrowernumber );
 749
 750     return { code => 'Canceled' };
 751 }
 752
 753 1;