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 = "RecordNotFound";
 197         }
 198
 199         # We don't want MARC to be displayed
 200         delete $biblioitem->{'marc'};
 201
 202         # nor the XML declaration of MARCXML
 203         $biblioitem->{'marcxml'} =~ s/<\?xml version="1.0" encoding="UTF-8"\?>//go;
 204
 205         # Get most of the needed data
 206         my $biblioitemnumber = $biblioitem->{'biblioitemnumber'};
 207         my @reserves         = GetReservesFromBiblionumber( $biblionumber, undef, undef );
 208         my $issues           = GetBiblioIssues($biblionumber);
 209         my $items            = GetItemsByBiblioitemnumber($biblioitemnumber);
 210
 211         # We loop over the items to clean them
 212         foreach my $item (@$items) {
 213
 214             # This hides additionnal XML subfields, we don't need these info
 215             delete $item->{'more_subfields_xml'};
 216
 217             # Display branch names instead of branch codes
 218             $item->{'homebranchname'}    = GetBranchName( $item->{'homebranch'} );
 219             $item->{'holdingbranchname'} = GetBranchName( $item->{'holdingbranch'} );
 220         }
 221
 222         # Hashref building...
 223         $biblioitem->{'items'}->{'item'}       = $items;
 224         $biblioitem->{'reserves'}->{'reserve'} = $reserves[1];
 225         $biblioitem->{'issues'}->{'issue'}     = $issues;
 226
 227         map { $biblioitem->{$_} = encode_entities( $biblioitem->{$_}, '&' ) } grep( !/marcxml/, keys %$biblioitem );
 228
 229         push @records, $biblioitem;
 230     }
 231
 232     return { record => \@records };
 233 }
 234
 235 =head2 GetAuthorityRecords
 236
 237 Given a list of authority record identifiers, returns a list of record
 238 objects that contain the authority records. The function user may request
 239 a specific metadata schema for the record objects.
 240
 241 Parameters:
 242
 243   - id (Required)
 244     list of authority record identifiers
 245   - schema (Optional)
 246     specifies the metadata schema of records to be returned, possible values:
 247       - MARCXML
 248
 249 =cut
 250
 251 sub GetAuthorityRecords {
 252     my ($cgi) = @_;
 253
 254     # If the user asks for an unsupported schema, return an error code
 255     if ( $cgi->param('schema') and $cgi->param('schema') ne "MARCXML" ) {
 256         return { code => 'UnsupportedSchema' };
 257     }
 258
 259     my $records;
 260
 261     # Let's loop over the authority IDs
 262     foreach my $authid ( split( / /, $cgi->param('id') ) ) {
 263
 264         # Get the record as XML string, or error code
 265         my $record = GetAuthorityXML($authid) || "<record><code>RecordNotFound</code></record>";
 266         $record =~ s/<\?xml(.*)\?>//go;
 267         $records .= $record;
 268     }
 269
 270     return $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( 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'} ) )[1]->{'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         $borrower->{'loans'}->{'loan'} = $issues;
 429     }
 430
 431     return $borrower;
 432 }
 433
 434 =head2 GetPatronStatus
 435
 436 Returns a patron's status information.
 437
 438 Parameters:
 439
 440   - patron_id (Required)
 441         the borrower ID
 442
 443 =cut
 444
 445 sub GetPatronStatus {
 446     my ($cgi) = @_;
 447
 448     # Get Member details
 449     my $borrowernumber = $cgi->param('patron_id');
 450     my $borrower = GetMemberDetails( $borrowernumber );
 451     return { code => 'PatronNotFound' } unless $$borrower{borrowernumber};
 452
 453     # Return the results
 454     return {
 455         type   => $$borrower{categorycode},
 456         status => 0, # TODO
 457         expiry => $$borrower{dateexpiry},
 458     };
 459 }
 460
 461 =head2 GetServices
 462
 463 Returns information about the services available on a particular item for
 464 a particular patron.
 465
 466 Parameters:
 467
 468   - patron_id (Required)
 469         a borrowernumber
 470   - item_id (Required)
 471         an itemnumber
 472 =cut
 473
 474 sub GetServices {
 475     my ($cgi) = @_;
 476
 477     # Get the member, or return an error code if not found
 478     my $borrowernumber = $cgi->param('patron_id');
 479     my $borrower = GetMemberDetails( $borrowernumber );
 480     return { code => 'PatronNotFound' } unless $$borrower{borrowernumber};
 481
 482     # Get the item, or return an error code if not found
 483     my $itemnumber = $cgi->param('item_id');
 484     my $item = GetItem( $itemnumber );
 485     return { code => 'RecordNotFound' } unless $$item{itemnumber};
 486
 487     my @availablefor;
 488
 489     # Reserve level management
 490     my $biblionumber = $item->{'biblionumber'};
 491     my $canbookbereserved = CanBookBeReserved( $borrower, $biblionumber );
 492     if ($canbookbereserved) {
 493         push @availablefor, 'title level hold';
 494         my $canitembereserved = IsAvailableForItemLevelRequest($itemnumber);
 495         if ($canitembereserved) {
 496             push @availablefor, 'item level hold';
 497         }
 498     }
 499
 500     # Reserve cancellation management
 501     my @reserves = GetReservesFromBorrowernumber( $borrowernumber, undef );
 502     my @reserveditems;
 503     foreach my $reserve (@reserves) {
 504         push @reserveditems, $reserve->{'itemnumber'};
 505     }
 506     if ( grep { $itemnumber eq $_ } @reserveditems ) {
 507         push @availablefor, 'hold cancellation';
 508     }
 509
 510     # Renewal management
 511     my @renewal = CanBookBeRenewed( $borrowernumber, $itemnumber );
 512     if ( $renewal[0] ) {
 513         push @availablefor, 'loan renewal';
 514     }
 515
 516     # Issuing management
 517     my $barcode = $item->{'barcode'} || '';
 518     $barcode = barcodedecode($barcode) if ( $barcode && C4::Context->preference('itemBarcodeInputFilter') );
 519     if ($barcode) {
 520         my ( $issuingimpossible, $needsconfirmation ) = CanBookBeIssued( $borrower, $barcode );
 521
 522         # TODO push @availablefor, 'loan';
 523     }
 524
 525     my $out;
 526     $out->{'AvailableFor'} = \@availablefor;
 527
 528     return $out;
 529 }
 530
 531 =head2 RenewLoan
 532
 533 Extends the due date for a borrower's existing issue.
 534
 535 Parameters:
 536
 537   - patron_id (Required)
 538         a borrowernumber
 539   - item_id (Required)
 540         an itemnumber
 541   - desired_due_date (Required)
 542         the date the patron would like the item returned by
 543
 544 =cut
 545
 546 sub RenewLoan {
 547     my ($cgi) = @_;
 548
 549     # Get borrower infos or return an error code
 550     my $borrowernumber = $cgi->param('patron_id');
 551     my $borrower = GetMemberDetails( $borrowernumber );
 552     return { code => 'PatronNotFound' } unless $$borrower{borrowernumber};
 553
 554     # Get the item, or return an error code
 555     my $itemnumber = $cgi->param('item_id');
 556     my $item = GetItem( $itemnumber );
 557     return { code => 'RecordNotFound' } unless $$item{itemnumber};
 558
 559     # Add renewal if possible
 560     my @renewal = CanBookBeRenewed( $borrowernumber, $itemnumber );
 561     if ( $renewal[0] ) { AddRenewal( $borrowernumber, $itemnumber ); }
 562
 563     my $issue = GetItemIssue($itemnumber);
 564
 565     # Hashref building
 566     my $out;
 567     $out->{'renewals'} = $issue->{'renewals'};
 568     $out->{'date_due'} = $issue->{'date_due'};
 569     $out->{'success'}  = $renewal[0];
 570     $out->{'error'}    = $renewal[1];
 571
 572     return $out;
 573 }
 574
 575 =head2 HoldTitle
 576
 577 Creates, for a borrower, a biblio-level hold reserve.
 578
 579 Parameters:
 580
 581   - patron_id (Required)
 582         a borrowernumber
 583   - bib_id (Required)
 584         a biblionumber
 585   - request_location (Required)
 586         IP address where the end user request is being placed
 587   - pickup_location (Optional)
 588         a branch code indicating the location to which to deliver the item for pickup
 589   - needed_before_date (Optional)
 590         date after which hold request is no longer needed
 591   - pickup_expiry_date (Optional)
 592         date after which item returned to shelf if item is not picked up
 593
 594 =cut
 595
 596 sub HoldTitle {
 597     my ($cgi) = @_;
 598
 599     # Get the borrower or return an error code
 600     my $borrowernumber = $cgi->param('patron_id');
 601     my $borrower = GetMemberDetails( $borrowernumber );
 602     return { code => 'PatronNotFound' } unless $$borrower{borrowernumber};
 603
 604     # Get the biblio record, or return an error code
 605     my $biblionumber = $cgi->param('bib_id');
 606     my ( $count, $biblio ) = GetBiblio( $biblionumber );
 607     return { code => 'RecordNotFound' } unless $$biblio{biblionumber};
 608
 609     my $title = $$biblio{title};
 610
 611     # Check if the biblio can be reserved
 612     return { code => 'NotHoldable' } unless CanBookBeReserved( $borrowernumber, $biblionumber );
 613
 614     my $branch;
 615
 616     # Pickup branch management
 617     if ( $cgi->param('pickup_location') ) {
 618         $branch = $cgi->param('pickup_location');
 619         my $branches = GetBranches;
 620         return { code => 'LocationNotFound' } unless $$branches{$branch};
 621     } else { # if the request provide no branch, use the borrower's branch
 622         $branch = $$borrower{branchcode};
 623     }
 624
 625     # Add the reserve
 626     #          $branch, $borrowernumber, $biblionumber, $constraint, $bibitems,  $priority, $notes, $title, $checkitem,  $found
 627     AddReserve( $branch, $borrowernumber, $biblionumber, 'a', undef, 0, undef, $title, undef, undef );
 628
 629     # Hashref building
 630     my $out;
 631     $out->{'title'}           = $title;
 632     $out->{'pickup_location'} = GetBranchName($branch);
 633
 634     # TODO $out->{'date_available'}  = '';
 635
 636     return $out;
 637 }
 638
 639 =head2 HoldItem
 640
 641 Creates, for a borrower, an item-level hold request on a specific item of
 642 a bibliographic record in Koha.
 643
 644 Parameters:
 645
 646   - patron_id (Required)
 647         a borrowernumber
 648   - bib_id (Required)
 649         a biblionumber
 650   - item_id (Required)
 651         an itemnumber
 652   - pickup_location (Optional)
 653         a branch code indicating the location to which to deliver the item for pickup
 654   - needed_before_date (Optional)
 655         date after which hold request is no longer needed
 656   - pickup_expiry_date (Optional)
 657         date after which item returned to shelf if item is not picked up
 658
 659 =cut
 660
 661 sub HoldItem {
 662     my ($cgi) = @_;
 663
 664     # Get the borrower or return an error code
 665     my $borrowernumber = $cgi->param('patron_id');
 666     my $borrower = GetMemberDetails( $borrowernumber );
 667     return { code => 'PatronNotFound' } unless $$borrower{borrowernumber};
 668
 669     # Get the biblio or return an error code
 670     my $biblionumber = $cgi->param('bib_id');
 671     my ( $count, $biblio ) = GetBiblio($biblionumber);
 672     return { code => 'RecordNotFound' } unless $$biblio{biblionumber};
 673
 674     my $title = $$biblio{title};
 675
 676     # Get the item or return an error code
 677     my $itemnumber = $cgi->param('item_id');
 678     my $item = GetItem( $itemnumber );
 679     return { code => 'RecordNotFound' } unless $$item{itemnumber};
 680
 681     # If the biblio does not match the item, return an error code
 682     return { code => 'RecordNotFound' } if $$item{biblionumber} ne $$biblio{biblionumber};
 683
 684     # Check for item disponibility
 685     my $canitembereserved = CanItemBeReserved( $borrowernumber, $itemnumber );
 686     my $canbookbereserved = CanBookBeReserved( $borrowernumber, $biblionumber );
 687     return { code => 'NotHoldable' } unless $canbookbereserved and $canitembereserved;
 688
 689     my $branch;
 690
 691     # Pickup branch management
 692     if ( $cgi->param('pickup_location') ) {
 693         $branch = $cgi->param('pickup_location');
 694         my $branches = GetBranches();
 695         return { code => 'LocationNotFound' } unless $$branches{$branch};
 696     } else { # if the request provide no branch, use the borrower's branch
 697         $branch = $$borrower{branchcode};
 698     }
 699
 700     my $rank;
 701     my $found;
 702
 703     # Get rank and found
 704     $rank = '0' unless C4::Context->preference('ReservesNeedReturns');
 705     if ( $item->{'holdingbranch'} eq $branch ) {
 706         $found = 'W' unless C4::Context->preference('ReservesNeedReturns');
 707     }
 708
 709     # Add the reserve
 710     #          $branch, $borrowernumber, $biblionumber, $constraint, $bibitems,  $priority, $notes, $title, $checkitem,  $found
 711     AddReserve( $branch, $borrowernumber, $biblionumber, 'a', undef, $rank, undef, $title, $itemnumber, $found );
 712
 713     # Hashref building
 714     my $out;
 715     $out->{'pickup_location'} = GetBranchName($branch);
 716
 717     # TODO $out->{'date_available'} = '';
 718
 719     return $out;
 720 }
 721
 722 =head2 CancelHold
 723
 724 Cancels an active reserve request for the borrower.
 725
 726 Parameters:
 727
 728   - patron_id (Required)
 729         a borrowernumber
 730   - item_id (Required)
 731         an itemnumber
 732
 733 =cut
 734
 735 sub CancelHold {
 736     my ($cgi) = @_;
 737
 738     # Get the borrower or return an error code
 739     my $borrowernumber = $cgi->param('patron_id');
 740     my $borrower = GetMemberDetails( $borrowernumber );
 741     return { code => 'PatronNotFound' } unless $$borrower{borrowernumber};
 742
 743     # Get the item or return an error code
 744     my $itemnumber = $cgi->param('item_id');
 745     my $item = GetItem( $itemnumber );
 746     return { code => 'RecordNotFound' } unless $$item{itemnumber};
 747
 748     # Get borrower's reserves
 749     my @reserves = GetReservesFromBorrowernumber( $borrowernumber, undef );
 750     my @reserveditems;
 751
 752     # ...and loop over it to build an array of reserved itemnumbers
 753     foreach my $reserve (@reserves) {
 754         push @reserveditems, $reserve->{'itemnumber'};
 755     }
 756
 757     # if the item was not reserved by the borrower, returns an error code
 758     return { code => 'NotCanceled' } unless any { $itemnumber eq $_ } @reserveditems;
 759
 760     # Cancel the reserve
 761     CancelReserve( $itemnumber, undef, $borrowernumber );
 762
 763     return { code => 'Canceled' };
 764 }
 765
 766 1;