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