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 with
  17 # Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
  18 # Suite 330, Boston, MA  02111-1307 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 { message => '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 { message => '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>RecordNotFound</record>";
 254         $record =~ s/<\?xml version="1.0" encoding="UTF-8"\?>//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
 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::ILSDI::Utility function...
 312     if ( not( BorrowerExists( $cgi->param('username'), $cgi->param('password') ) ) ) {
 313         return { message => '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, undef );
 353     if ( not $borrower->{'borrowernumber'} ) {
 354         return { message => 'PatronNotFound' };
 355     }
 356
 357     # Cleaning the borrower hashref
 358     $borrower->{'charges'}    = $borrower->{'flags'}->{'CHARGES'}->{'amount'};
 359     $borrower->{'branchname'} = GetBranchName( $borrower->{'branchcode'} );
 360     delete $borrower->{'flags'};
 361     delete $borrower->{'userid'};
 362     delete $borrower->{'password'};
 363
 364     # Contact fields management
 365     if ( $cgi->param('show_contact') eq "0" ) {
 366
 367         # Define contact fields
 368         my @contactfields = (
 369             'email',              'emailpro',           'fax',                 'mobile',          'phone',             'phonepro',
 370             'streetnumber',       'zipcode',            'city',                'streettype',      'B_address',         'B_city',
 371             'B_email',            'B_phone',            'B_zipcode',           'address',         'address2',          'altcontactaddress1',
 372             'altcontactaddress2', 'altcontactaddress3', 'altcontactfirstname', 'altcontactphone', 'altcontactsurname', 'altcontactzipcode'
 373         );
 374
 375         # and delete them
 376         foreach my $field (@contactfields) {
 377             delete $borrower->{$field};
 378         }
 379     }
 380
 381     # Fines management
 382     if ( $cgi->param('show_fines') eq "1" ) {
 383         my @charges;
 384         for ( my $i = 1 ; my @charge = getcharges( $borrowernumber, undef, $i ) ; $i++ ) {
 385             push( @charges, @charge );
 386         }
 387         $borrower->{'fines'}->{'fine'} = \@charges;
 388     }
 389
 390     # Reserves management
 391     if ( $cgi->param('show_holds') eq "1" ) {
 392
 393         # Get borrower's reserves
 394         my @reserves = GetReservesFromBorrowernumber( $borrowernumber, undef );
 395         foreach my $reserve (@reserves) {
 396
 397             # Get additional informations
 398             my $item = GetBiblioFromItemNumber( $reserve->{'itemnumber'}, undef );
 399             my $branchname = GetBranchName( $reserve->{'branchcode'} );
 400
 401             # Remove unwanted fields
 402             delete $item->{'marc'};
 403             delete $item->{'marcxml'};
 404             delete $item->{'more_subfields_xml'};
 405
 406             # Add additional fields
 407             $reserve->{'item'}       = $item;
 408             $reserve->{'branchname'} = $branchname;
 409             $reserve->{'title'}      = ( GetBiblio( $reserve->{'biblionumber'} ) )[1]->{'title'};
 410         }
 411         $borrower->{'holds'}->{'hold'} = \@reserves;
 412     }
 413
 414     # Issues management
 415     if ( $cgi->param('show_loans') eq "1" ) {
 416         my $issues = GetPendingIssues($borrowernumber);
 417         $borrower->{'loans'}->{'loan'} = $issues;
 418     }
 419
 420     return $borrower;
 421 }
 422
 423 =head2 GetPatronStatus
 424
 425         Returns a patron's status information.
 426
 427         Parameters:
 428
 429         - patron_id (Required)
 430                 the borrower ID
 431
 432 =cut
 433
 434 sub GetPatronStatus {
 435     my ($cgi) = @_;
 436
 437     # Get Member details
 438     my $borrowernumber = $cgi->param('patron_id');
 439     my $borrower = GetMemberDetails( $borrowernumber, undef );
 440     if ( not $borrower->{'borrowernumber'} ) {
 441         return { message => 'PatronNotFound' };
 442     }
 443
 444     # Hashref building
 445     my $patron;
 446     $patron->{'type'}   = $borrower->{'categorycode'};
 447     $patron->{'status'} = 0;                             #TODO
 448     $patron->{'expiry'} = $borrower->{'dateexpiry'};
 449
 450     return $patron;
 451 }
 452
 453 =head2 GetServices
 454
 455         Returns information about the services available on a particular item for
 456         a particular patron.
 457
 458         Parameters:
 459
 460         - patron_id (Required)
 461                 a borrowernumber
 462         - item_id (Required)
 463                 an itemnumber
 464 =cut
 465
 466 sub GetServices {
 467     my ($cgi) = @_;
 468
 469     # Get the member, or return an error code if not found
 470     my $borrowernumber = $cgi->param('patron_id');
 471     my $borrower = GetMemberDetails( $borrowernumber, undef );
 472     if ( not $borrower->{'borrowernumber'} ) {
 473         return { message => 'PatronNotFound' };
 474     }
 475
 476     # Get the item, or return an error code if not found
 477     my $itemnumber = $cgi->param('item_id');
 478     my $item = GetItem( $itemnumber, undef, undef );
 479     if ( not $item->{'itemnumber'} ) {
 480         return { message => 'RecordNotFound' };
 481     }
 482
 483     my @availablefor;
 484
 485     # Reserve level management
 486     my $biblionumber = $item->{'biblionumber'};
 487     my $canbookbereserved = CanBookBeReserved( $borrower, $biblionumber );
 488     if ($canbookbereserved) {
 489         push @availablefor, 'title level hold';
 490         my $canitembereserved = IsAvailableForItemLevelRequest($itemnumber);
 491         if ($canitembereserved) {
 492             push @availablefor, 'item level hold';
 493         }
 494     }
 495
 496     # Reserve cancellation management
 497     my @reserves = GetReservesFromBorrowernumber( $borrowernumber, undef );
 498     my @reserveditems;
 499     foreach my $reserve (@reserves) {
 500         push @reserveditems, $reserve->{'itemnumber'};
 501     }
 502     if ( grep { $itemnumber eq $_ } @reserveditems ) {
 503         push @availablefor, 'hold cancellation';
 504     }
 505
 506     # Renewal management
 507     my @renewal = CanBookBeRenewed( $borrowernumber, $itemnumber );
 508     if ( $renewal[0] ) {
 509         push @availablefor, 'loan renewal';
 510     }
 511
 512     # Issuing management
 513     my $barcode = $item->{'barcode'} || '';
 514     $barcode = barcodedecode($barcode) if ( $barcode && C4::Context->preference('itemBarcodeInputFilter') );
 515     if ($barcode) {
 516         my ( $issuingimpossible, $needsconfirmation ) = CanBookBeIssued( $borrower, $barcode );
 517
 518         # TODO push @availablefor, 'loan';
 519     }
 520
 521     my $out;
 522     $out->{'AvailableFor'} = \@availablefor;
 523
 524     return $out;
 525 }
 526
 527 =head2 RenewLoan
 528
 529         Extends the due date for a borrower's existing issue.
 530
 531         Parameters:
 532
 533         - patron_id (Required)
 534                 a borrowernumber
 535         - item_id (Required)
 536                 an itemnumber
 537         - desired_due_date (Required)
 538                 the date the patron would like the item returned by
 539
 540 =cut
 541
 542 sub RenewLoan {
 543     my ($cgi) = @_;
 544
 545     # Get borrower infos or return an error code
 546     my $borrowernumber = $cgi->param('patron_id');
 547     my $borrower = GetMemberDetails( $borrowernumber, undef );
 548     if ( not $borrower->{'borrowernumber'} ) {
 549         return { message => 'PatronNotFound' };
 550     }
 551
 552     # Get the item, or return an error code
 553     my $itemnumber = $cgi->param('item_id');
 554     my $item = GetItem( $itemnumber, undef, undef );
 555     if ( not $item->{'itemnumber'} ) {
 556         return { message => 'RecordNotFound' };
 557     }
 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, undef );
 602     if ( not $borrower->{'borrowernumber'} ) {
 603         return { message => 'PatronNotFound' };
 604     }
 605
 606     # Get the biblio record, or return an error code
 607     my $biblionumber = $cgi->param('bib_id');
 608     my ( $count, $biblio ) = GetBiblio($biblionumber);
 609     if ( not $biblio->{'biblionumber'} ) {
 610         return { message => 'RecordNotFound' };
 611     }
 612     my $title = $biblio->{'title'};
 613
 614     # Check if the biblio can be reserved
 615     my $canbereserved = CanBookBeReserved( $borrower, $biblionumber );
 616     if ( not $canbereserved ) {
 617         return { message => 'NotHoldable' };
 618     }
 619
 620     my $branch;
 621
 622     # Pickup branch management
 623     if ( $cgi->param('pickup_location') ) {
 624         $branch = $cgi->param('pickup_location');
 625         my $branches = GetBranches();
 626         if ( not $branches->{$branch} ) {
 627             return { message => 'LocationNotFound' };
 628         }
 629     } else {    # if user provide no branch, use his own
 630         $branch = $borrower->{'branchcode'};
 631     }
 632
 633     # Add the reserve
 634     #          $branch, $borrowernumber, $biblionumber, $constraint, $bibitems,  $priority, $notes, $title, $checkitem,  $found
 635     AddReserve( $branch, $borrowernumber, $biblionumber, 'a', undef, 0, undef, $title, undef, undef );
 636
 637     # Hashref building
 638     my $out;
 639     $out->{'title'}           = $title;
 640     $out->{'pickup_location'} = GetBranchName($branch);
 641
 642     # TODO $out->{'date_available'}  = '';
 643
 644     return $out;
 645 }
 646
 647 =head2 HoldItem
 648
 649         Creates, for a borrower, an item-level hold request on a specific item of
 650         a bibliographic record in Koha.
 651
 652         Parameters:
 653
 654         - patron_id (Required)
 655                 a borrowernumber
 656         - bib_id (Required)
 657                 a biblionumber
 658         - item_id (Required)
 659                 an itemnumber
 660         - pickup_location (Optional)
 661                 a branch code indicating the location to which to deliver the item for pickup
 662         - needed_before_date (Optional)
 663                 date after which hold request is no longer needed
 664         - pickup_expiry_date (Optional)
 665                 date after which item returned to shelf if item is not picked up
 666
 667 =cut
 668
 669 sub HoldItem {
 670     my ($cgi) = @_;
 671
 672     # Get the borrower or return an error code
 673     my $borrowernumber = $cgi->param('patron_id');
 674     my $borrower = GetMemberDetails( $borrowernumber, undef );
 675     if ( not $borrower->{'borrowernumber'} ) {
 676         return { message => 'PatronNotFound' };
 677     }
 678
 679     # Get the biblio or return an error code
 680     my $biblionumber = $cgi->param('bib_id');
 681     my ( $count, $biblio ) = GetBiblio($biblionumber);
 682     if ( not $biblio->{'biblionumber'} ) {
 683         return { message => 'RecordNotFound' };
 684     }
 685     my $title = $biblio->{'title'};
 686
 687     # Get the item or return an error code
 688     my $itemnumber = $cgi->param('item_id');
 689     my $item = GetItem( $itemnumber, undef, undef );
 690     if ( not $item->{'itemnumber'} ) {
 691         return { message => 'RecordNotFound' };
 692     }
 693
 694     # if the biblio does not match the item, return an error code
 695     if ( $item->{'biblionumber'} ne $biblio->{'biblionumber'} ) {
 696         return { message => 'RecordNotFound' };
 697     }
 698
 699     # Check for item disponibility
 700     my $canitembereserved = IsAvailableForItemLevelRequest($itemnumber);
 701     my $canbookbereserved = CanBookBeReserved( $borrower, $biblionumber );
 702     if ( ( not $canbookbereserved ) or not($canitembereserved) ) {
 703         return { message => 'NotHoldable' };
 704     }
 705
 706     my $branch;
 707
 708     # Pickup branch management
 709     if ( $cgi->param('pickup_location') ) {
 710         $branch = $cgi->param('pickup_location');
 711         my $branches = GetBranches();
 712         if ( not $branches->{$branch} ) {
 713             return { message => 'LocationNotFound' };
 714         }
 715     } else {    # if user provide no branch, use his own
 716         $branch = $borrower->{'branchcode'};
 717     }
 718
 719     my $rank;
 720     my $found;
 721
 722     # Get rank and found
 723     $rank = '0' unless C4::Context->preference('ReservesNeedReturns');
 724     if ( $item->{'holdingbranch'} eq $branch ) {
 725         $found = 'W' unless C4::Context->preference('ReservesNeedReturns');
 726     }
 727
 728     # Add the reserve
 729     #          $branch, $borrowernumber, $biblionumber, $constraint, $bibitems,  $priority, $notes, $title, $checkitem,  $found
 730     AddReserve( $branch, $borrowernumber, $biblionumber, 'a', undef, $rank, undef, $title, $itemnumber, $found );
 731
 732     # Hashref building
 733     my $out;
 734     $out->{'pickup_location'} = GetBranchName($branch);
 735
 736     # TODO $out->{'date_available'} = '';
 737
 738     return $out;
 739 }
 740
 741 =head2 CancelHold
 742
 743         Cancels an active reserve request for the borrower.
 744
 745         Parameters:
 746
 747         - patron_id (Required)
 748                 a borrowernumber
 749         - item_id (Required)
 750                 an itemnumber
 751
 752 =cut
 753
 754 sub CancelHold {
 755     my ($cgi) = @_;
 756
 757     # Get the borrower or return an error code
 758     my $borrowernumber = $cgi->param('patron_id');
 759     my $borrower = GetMemberDetails( $borrowernumber, undef );
 760     if ( not $borrower->{'borrowernumber'} ) {
 761         return { message => 'PatronNotFound' };
 762     }
 763
 764     # Get the item or return an error code
 765     my $itemnumber = $cgi->param('item_id');
 766     my $item = GetItem( $itemnumber, undef, undef );
 767     if ( not $item->{'itemnumber'} ) {
 768         return { message => 'RecordNotFound' };
 769     }
 770
 771     # Get borrower's reserves
 772     my @reserves = GetReservesFromBorrowernumber( $borrowernumber, undef );
 773     my @reserveditems;
 774
 775     # ...and loop over it to build an array of reserved itemnumbers
 776     foreach my $reserve (@reserves) {
 777         push @reserveditems, $reserve->{'itemnumber'};
 778     }
 779
 780     # if the item was not reserved by the borrower, returns an error code
 781     if ( not grep { $itemnumber eq $_ } @reserveditems ) {
 782         return { message => 'NotCanceled' };
 783     }
 784
 785     # Cancel the reserve
 786     CancelReserve( $itemnumber, undef, $borrowernumber );
 787
 788     return { message => 'Canceled' };
 789
 790 }
 791
 792 1;