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         push @records, $biblioitem;
 218     }
 219
 220     return { record => \@records };
 221 }
 222
 223 =head2 GetAuthorityRecords
 224
 225         Given a list of authority record identifiers, returns a list of record
 226         objects that contain the authority records. The function user may request
 227         a specific metadata schema for the record objects.
 228
 229         Parameters:
 230
 231         - id (Required)
 232             list of authority record identifiers
 233         - schema (Optional)
 234             specifies the metadata schema of records to be returned, possible values:
 235                   - MARCXML
 236
 237 =cut
 238
 239 sub GetAuthorityRecords {
 240     my ($cgi) = @_;
 241
 242     # If the user asks for an unsupported schema, return an error code
 243     if ( $cgi->param('schema') and $cgi->param('schema') ne "MARCXML" ) {
 244         return { code => 'UnsupportedSchema' };
 245     }
 246
 247     my $records;
 248
 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><code>RecordNotFound</code></record>";
 254         $record =~ s/<\?xml(.*)\?>//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_type') => $cgi->param('id'));
 283     if ( not $borrower->{'borrowernumber'} ) {
 284         return { message => 'PatronNotFound' };
 285     }
 286
 287     # Build the hashref
 288     my $patron->{'id'} = $borrower->{'borrowernumber'};
 289     return { code => 'PatronNotFound' } unless $$borrower{borrowernumber};
 290
 291     # ...and return his ID
 292     return $patron;
 293 }
 294
 295 =head2 AuthenticatePatron
 296
 297         Authenticates a user's login credentials and returns the identifier for
 298         the patron.
 299
 300         Parameters:
 301
 302         - username (Required)
 303                 user's login identifier
 304         - password (Required)
 305                 user's password
 306
 307 =cut
 308
 309 sub AuthenticatePatron {
 310     my ($cgi) = @_;
 311
 312     # Check if borrower exists, using a C4::Auth function...
 313     unless( checkpw( C4::Context->dbh, $cgi->param('username'), $cgi->param('password') ) ) {
 314         return { code => 'PatronNotFound' };
 315     }
 316
 317     # Get the borrower
 318     my $borrower = GetMember( userid => $cgi->param('username') );
 319
 320     # Build the hashref
 321     my $patron->{'id'} = $borrower->{'borrowernumber'};
 322
 323     # ... and return his ID
 324     return $patron;
 325 }
 326
 327 =head2 GetPatronInfo
 328
 329         Returns specified information about the patron, based on options in the
 330         request. This function can optionally return patron's contact information,
 331         fine information, hold request information, and loan information.
 332
 333         Parameters:
 334
 335         - patron_id (Required)
 336                 the borrowernumber
 337         - show_contact (Optional, default 1)
 338                 whether or not to return patron's contact information in the response
 339         - show_fines (Optional, default 0)
 340                 whether or not to return fine information in the response
 341         - show_holds (Optional, default 0)
 342                 whether or not to return hold request information in the response
 343         - show_loans (Optional, default 0)
 344                 whether or not to return loan information request information in the response
 345
 346 =cut
 347
 348 sub GetPatronInfo {
 349     my ($cgi) = @_;
 350
 351     # Get Member details
 352     my $borrowernumber = $cgi->param('patron_id');
 353     my $borrower = GetMemberDetails( $borrowernumber );
 354     return { code => 'PatronNotFound' } unless $$borrower{borrowernumber};
 355
 356     # Cleaning the borrower hashref
 357     $borrower->{'charges'}    = $borrower->{'flags'}->{'CHARGES'}->{'amount'};
 358     $borrower->{'branchname'} = GetBranchName( $borrower->{'branchcode'} );
 359     delete $borrower->{'flags'};
 360     delete $borrower->{'userid'};
 361     delete $borrower->{'password'};
 362
 363     # Contact fields management
 364     if ( $cgi->param('show_contact') eq "0" ) {
 365
 366         # Define contact fields
 367         my @contactfields = (
 368             'email',              'emailpro',           'fax',                 'mobile',          'phone',             'phonepro',
 369             'streetnumber',       'zipcode',            'city',                'streettype',      'B_address',         'B_city',
 370             'B_email',            'B_phone',            'B_zipcode',           'address',         'address2',          'altcontactaddress1',
 371             'altcontactaddress2', 'altcontactaddress3', 'altcontactfirstname', 'altcontactphone', 'altcontactsurname', 'altcontactzipcode'
 372         );
 373
 374         # and delete them
 375         foreach my $field (@contactfields) {
 376             delete $borrower->{$field};
 377         }
 378     }
 379
 380     # Fines management
 381     if ( $cgi->param('show_fines') eq "1" ) {
 382         my @charges;
 383         for ( my $i = 1 ; my @charge = getcharges( $borrowernumber, undef, $i ) ; $i++ ) {
 384             push( @charges, @charge );
 385         }
 386         $borrower->{'fines'}->{'fine'} = \@charges;
 387     }
 388
 389     # Reserves management
 390     if ( $cgi->param('show_holds') eq "1" ) {
 391
 392         # Get borrower's reserves
 393         my @reserves = GetReservesFromBorrowernumber( $borrowernumber, undef );
 394         foreach my $reserve (@reserves) {
 395
 396             # Get additional informations
 397             my $item = GetBiblioFromItemNumber( $reserve->{'itemnumber'}, undef );
 398             my $branchname = GetBranchName( $reserve->{'branchcode'} );
 399
 400             # Remove unwanted fields
 401             delete $item->{'marc'};
 402             delete $item->{'marcxml'};
 403             delete $item->{'more_subfields_xml'};
 404
 405             # Add additional fields
 406             $reserve->{'item'}       = $item;
 407             $reserve->{'branchname'} = $branchname;
 408             $reserve->{'title'}      = ( GetBiblio( $reserve->{'biblionumber'} ) )[1]->{'title'};
 409         }
 410         $borrower->{'holds'}->{'hold'} = \@reserves;
 411     }
 412
 413     # Issues management
 414     if ( $cgi->param('show_loans') eq "1" ) {
 415         my $issues = GetPendingIssues($borrowernumber);
 416         $borrower->{'loans'}->{'loan'} = $issues;
 417     }
 418
 419     return $borrower;
 420 }
 421
 422 =head2 GetPatronStatus
 423
 424         Returns a patron's status information.
 425
 426         Parameters:
 427
 428         - patron_id (Required)
 429                 the borrower ID
 430
 431 =cut
 432
 433 sub GetPatronStatus {
 434     my ($cgi) = @_;
 435
 436     # Get Member details
 437     my $borrowernumber = $cgi->param('patron_id');
 438     my $borrower = GetMemberDetails( $borrowernumber );
 439     return { code => 'PatronNotFound' } unless $$borrower{borrowernumber};
 440
 441     # Return the results
 442     return {
 443         type   => $$borrower{categorycode},
 444         status => 0, # TODO
 445         expiry => $$borrower{dateexpiry},
 446     };
 447 }
 448
 449 =head2 GetServices
 450
 451         Returns information about the services available on a particular item for
 452         a particular patron.
 453
 454         Parameters:
 455
 456         - patron_id (Required)
 457                 a borrowernumber
 458         - item_id (Required)
 459                 an itemnumber
 460 =cut
 461
 462 sub GetServices {
 463     my ($cgi) = @_;
 464
 465     # Get the member, or return an error code if not found
 466     my $borrowernumber = $cgi->param('patron_id');
 467     my $borrower = GetMemberDetails( $borrowernumber );
 468     return { code => 'PatronNotFound' } unless $$borrower{borrowernumber};
 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 );
 473     return { code => 'RecordNotFound' } unless $$item{itemnumber};
 474
 475     my @availablefor;
 476
 477     # Reserve level management
 478     my $biblionumber = $item->{'biblionumber'};
 479     my $canbookbereserved = CanBookBeReserved( $borrower, $biblionumber );
 480     if ($canbookbereserved) {
 481         push @availablefor, 'title level hold';
 482         my $canitembereserved = IsAvailableForItemLevelRequest($itemnumber);
 483         if ($canitembereserved) {
 484             push @availablefor, 'item level hold';
 485         }
 486     }
 487
 488     # Reserve cancellation management
 489     my @reserves = GetReservesFromBorrowernumber( $borrowernumber, undef );
 490     my @reserveditems;
 491     foreach my $reserve (@reserves) {
 492         push @reserveditems, $reserve->{'itemnumber'};
 493     }
 494     if ( grep { $itemnumber eq $_ } @reserveditems ) {
 495         push @availablefor, 'hold cancellation';
 496     }
 497
 498     # Renewal management
 499     my @renewal = CanBookBeRenewed( $borrowernumber, $itemnumber );
 500     if ( $renewal[0] ) {
 501         push @availablefor, 'loan renewal';
 502     }
 503
 504     # Issuing management
 505     my $barcode = $item->{'barcode'} || '';
 506     $barcode = barcodedecode($barcode) if ( $barcode && C4::Context->preference('itemBarcodeInputFilter') );
 507     if ($barcode) {
 508         my ( $issuingimpossible, $needsconfirmation ) = CanBookBeIssued( $borrower, $barcode );
 509
 510         # TODO push @availablefor, 'loan';
 511     }
 512
 513     my $out;
 514     $out->{'AvailableFor'} = \@availablefor;
 515
 516     return $out;
 517 }
 518
 519 =head2 RenewLoan
 520
 521         Extends the due date for a borrower's existing issue.
 522
 523         Parameters:
 524
 525         - patron_id (Required)
 526                 a borrowernumber
 527         - item_id (Required)
 528                 an itemnumber
 529         - desired_due_date (Required)
 530                 the date the patron would like the item returned by
 531
 532 =cut
 533
 534 sub RenewLoan {
 535     my ($cgi) = @_;
 536
 537     # Get borrower infos or return an error code
 538     my $borrowernumber = $cgi->param('patron_id');
 539     my $borrower = GetMemberDetails( $borrowernumber );
 540     return { code => 'PatronNotFound' } unless $$borrower{borrowernumber};
 541
 542     # Get the item, or return an error code
 543     my $itemnumber = $cgi->param('item_id');
 544     my $item = GetItem( $itemnumber );
 545     return { code => 'RecordNotFound' } unless $$item{itemnumber};
 546
 547     # Add renewal if possible
 548     my @renewal = CanBookBeRenewed( $borrowernumber, $itemnumber );
 549     if ( $renewal[0] ) { AddRenewal( $borrowernumber, $itemnumber ); }
 550
 551     my $issue = GetItemIssue($itemnumber);
 552
 553     # Hashref building
 554     my $out;
 555     $out->{'renewals'} = $issue->{'renewals'};
 556     $out->{'date_due'} = $issue->{'date_due'};
 557     $out->{'success'}  = $renewal[0];
 558     $out->{'error'}    = $renewal[1];
 559
 560     return $out;
 561 }
 562
 563 =head2 HoldTitle
 564
 565         Creates, for a borrower, a biblio-level hold reserve.
 566
 567         Parameters:
 568
 569         - patron_id (Required)
 570                 a borrowernumber
 571         - bib_id (Required)
 572                 a biblionumber
 573         - request_location (Required)
 574                 IP address where the end user request is being placed
 575         - pickup_location (Optional)
 576                 a branch code indicating the location to which to deliver the item for pickup
 577         - needed_before_date (Optional)
 578                 date after which hold request is no longer needed
 579         - pickup_expiry_date (Optional)
 580                 date after which item returned to shelf if item is not picked up
 581
 582 =cut
 583
 584 sub HoldTitle {
 585     my ($cgi) = @_;
 586
 587     # Get the borrower or return an error code
 588     my $borrowernumber = $cgi->param('patron_id');
 589     my $borrower = GetMemberDetails( $borrowernumber );
 590     return { code => 'PatronNotFound' } unless $$borrower{borrowernumber};
 591
 592     # Get the biblio record, or return an error code
 593     my $biblionumber = $cgi->param('bib_id');
 594     my ( $count, $biblio ) = GetBiblio( $biblionumber );
 595     return { code => 'RecordNotFound' } unless $$biblio{biblionumber};
 596
 597     my $title = $$biblio{title};
 598
 599     # Check if the biblio can be reserved
 600     return { code => 'NotHoldable' } unless CanBookBeReserved( $borrowernumber, $biblionumber );
 601
 602     my $branch;
 603
 604     # Pickup branch management
 605     if ( $cgi->param('pickup_location') ) {
 606         $branch = $cgi->param('pickup_location');
 607         my $branches = GetBranches;
 608         return { code => 'LocationNotFound' } unless $$branches{$branch};
 609     } else { # if the request provide no branch, use the borrower's branch
 610         $branch = $$borrower{branchcode};
 611     }
 612
 613     # Add the reserve
 614     #          $branch, $borrowernumber, $biblionumber, $constraint, $bibitems,  $priority, $notes, $title, $checkitem,  $found
 615     AddReserve( $branch, $borrowernumber, $biblionumber, 'a', undef, 0, undef, $title, undef, undef );
 616
 617     # Hashref building
 618     my $out;
 619     $out->{'title'}           = $title;
 620     $out->{'pickup_location'} = GetBranchName($branch);
 621
 622     # TODO $out->{'date_available'}  = '';
 623
 624     return $out;
 625 }
 626
 627 =head2 HoldItem
 628
 629         Creates, for a borrower, an item-level hold request on a specific item of
 630         a bibliographic record in Koha.
 631
 632         Parameters:
 633
 634         - patron_id (Required)
 635                 a borrowernumber
 636         - bib_id (Required)
 637                 a biblionumber
 638         - item_id (Required)
 639                 an itemnumber
 640         - pickup_location (Optional)
 641                 a branch code indicating the location to which to deliver the item for pickup
 642         - needed_before_date (Optional)
 643                 date after which hold request is no longer needed
 644         - pickup_expiry_date (Optional)
 645                 date after which item returned to shelf if item is not picked up
 646
 647 =cut
 648
 649 sub HoldItem {
 650     my ($cgi) = @_;
 651
 652     # Get the borrower or return an error code
 653     my $borrowernumber = $cgi->param('patron_id');
 654     my $borrower = GetMemberDetails( $borrowernumber );
 655     return { code => 'PatronNotFound' } unless $$borrower{borrowernumber};
 656
 657     # Get the biblio or return an error code
 658     my $biblionumber = $cgi->param('bib_id');
 659     my ( $count, $biblio ) = GetBiblio($biblionumber);
 660     return { code => 'RecordNotFound' } unless $$biblio{biblionumber};
 661
 662     my $title = $$biblio{title};
 663
 664     # Get the item or return an error code
 665     my $itemnumber = $cgi->param('item_id');
 666     my $item = GetItem( $itemnumber );
 667     return { code => 'RecordNotFound' } unless $$item{itemnumber};
 668
 669     # If the biblio does not match the item, return an error code
 670     return { code => 'RecordNotFound' } if $$item{biblionumber} ne $$biblio{biblionumber};
 671
 672     # Check for item disponibility
 673     my $canitembereserved = CanItemBeReserved( $borrowernumber, $itemnumber );
 674     my $canbookbereserved = CanBookBeReserved( $borrowernumber, $biblionumber );
 675     return { code => 'NotHoldable' } unless $canbookbereserved and $canitembereserved;
 676
 677     my $branch;
 678
 679     # Pickup branch management
 680     if ( $cgi->param('pickup_location') ) {
 681         $branch = $cgi->param('pickup_location');
 682         my $branches = GetBranches();
 683         return { code => 'LocationNotFound' } unless $$branches{$branch};
 684     } else { # if the request provide no branch, use the borrower's branch
 685         $branch = $$borrower{branchcode};
 686     }
 687
 688     my $rank;
 689     my $found;
 690
 691     # Get rank and found
 692     $rank = '0' unless C4::Context->preference('ReservesNeedReturns');
 693     if ( $item->{'holdingbranch'} eq $branch ) {
 694         $found = 'W' unless C4::Context->preference('ReservesNeedReturns');
 695     }
 696
 697     # Add the reserve
 698     #          $branch, $borrowernumber, $biblionumber, $constraint, $bibitems,  $priority, $notes, $title, $checkitem,  $found
 699     AddReserve( $branch, $borrowernumber, $biblionumber, 'a', undef, $rank, undef, $title, $itemnumber, $found );
 700
 701     # Hashref building
 702     my $out;
 703     $out->{'pickup_location'} = GetBranchName($branch);
 704
 705     # TODO $out->{'date_available'} = '';
 706
 707     return $out;
 708 }
 709
 710 =head2 CancelHold
 711
 712         Cancels an active reserve request for the borrower.
 713
 714         Parameters:
 715
 716         - patron_id (Required)
 717                 a borrowernumber
 718         - item_id (Required)
 719                 an itemnumber
 720
 721 =cut
 722
 723 sub CancelHold {
 724     my ($cgi) = @_;
 725
 726     # Get the borrower or return an error code
 727     my $borrowernumber = $cgi->param('patron_id');
 728     my $borrower = GetMemberDetails( $borrowernumber );
 729     return { code => 'PatronNotFound' } unless $$borrower{borrowernumber};
 730
 731     # Get the item or return an error code
 732     my $itemnumber = $cgi->param('item_id');
 733     my $item = GetItem( $itemnumber );
 734     return { code => 'RecordNotFound' } unless $$item{itemnumber};
 735
 736     # Get borrower's reserves
 737     my @reserves = GetReservesFromBorrowernumber( $borrowernumber, undef );
 738     my @reserveditems;
 739
 740     # ...and loop over it to build an array of reserved itemnumbers
 741     foreach my $reserve (@reserves) {
 742         push @reserveditems, $reserve->{'itemnumber'};
 743     }
 744
 745     # if the item was not reserved by the borrower, returns an error code
 746     return { code => 'NotCanceled' } unless any { $itemnumber eq $_ } @reserveditems;
 747
 748     # Cancel the reserve
 749     CancelReserve( $itemnumber, undef, $borrowernumber );
 750
 751     return { code => 'Canceled' };
 752 }
 753
 754 1;