Koha/Illrequest.pm

   1 package Koha::Illrequest;
   2
   3 # Copyright PTFS Europe 2016,2018
   4 #
   5 # This file is part of Koha.
   6 #
   7 # Koha is free software; you can redistribute it and/or modify it
   8 # under the terms of the GNU General Public License as published by
   9 # the Free Software Foundation; either version 3 of the License, or
  10 # (at your option) any later version.
  11 #
  12 # Koha is distributed in the hope that it will be useful, but
  13 # WITHOUT ANY WARRANTY; without even the implied warranty of
  14 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  15 # GNU General Public License for more details.
  16 #
  17 # You should have received a copy of the GNU General Public License
  18 # along with Koha; if not, see <http://www.gnu.org/licenses>.
  19
  20 use Modern::Perl;
  21
  22 use Clone 'clone';
  23 use File::Basename qw( basename );
  24 use Encode qw( encode );
  25 use Mail::Sendmail;
  26 use Try::Tiny;
  27 use DateTime;
  28
  29 use Koha::Database;
  30 use Koha::Email;
  31 use Koha::Exceptions::Ill;
  32 use Koha::Illcomments;
  33 use Koha::Illrequestattributes;
  34 use Koha::AuthorisedValue;
  35 use Koha::Illrequest::Logger;
  36 use Koha::Patron;
  37 use Koha::AuthorisedValues;
  38 use Koha::Biblios;
  39 use Koha::Items;
  40 use Koha::ItemTypes;
  41 use Koha::Libraries;
  42 use C4::Items qw( AddItem );
  43 use C4::Circulation qw( CanBookBeIssued AddIssue  );
  44
  45 use base qw(Koha::Object);
  46
  47 =head1 NAME
  48
  49 Koha::Illrequest - Koha Illrequest Object class
  50
  51 =head1 (Re)Design
  52
  53 An ILLRequest consists of two parts; the Illrequest Koha::Object, and a series
  54 of related Illrequestattributes.
  55
  56 The former encapsulates the basic necessary information that any ILL requires
  57 to be usable in Koha.  The latter is a set of additional properties used by
  58 one of the backends.
  59
  60 The former subsumes the legacy "Status" object.  The latter remains
  61 encapsulated in the "Record" object.
  62
  63 TODO:
  64
  65 - Anything invoking the ->status method; annotated with:
  66   + # Old use of ->status !
  67
  68 =head1 API
  69
  70 =head2 Backend API Response Principles
  71
  72 All methods should return a hashref in the following format:
  73
  74 =over
  75
  76 =item * error
  77
  78 This should be set to 1 if an error was encountered.
  79
  80 =item * status
  81
  82 The status should be a string from the list of statuses detailed below.
  83
  84 =item * message
  85
  86 The message is a free text field that can be passed on to the end user.
  87
  88 =item * value
  89
  90 The value returned by the method.
  91
  92 =back
  93
  94 =head2 Interface Status Messages
  95
  96 =over
  97
  98 =item * branch_address_incomplete
  99
 100 An interface request has determined branch address details are incomplete.
 101
 102 =item * cancel_success
 103
 104 The interface's cancel_request method was successful in cancelling the
 105 Illrequest using the API.
 106
 107 =item * cancel_fail
 108
 109 The interface's cancel_request method failed to cancel the Illrequest using
 110 the API.
 111
 112 =item * unavailable
 113
 114 The interface's request method returned saying that the desired item is not
 115 available for request.
 116
 117 =back
 118
 119 =head2 Class methods
 120
 121 =head3 statusalias
 122
 123     my $statusalias = $request->statusalias;
 124
 125 Returns a request's status alias, as a Koha::AuthorisedValue instance
 126 or implicit undef. This is distinct from status_alias, which only returns
 127 the value in the status_alias column, this method returns the entire
 128 AuthorisedValue object
 129
 130 =cut
 131
 132 sub statusalias {
 133     my ( $self ) = @_;
 134     return unless $self->status_alias;
 135     # We can't know which result is the right one if there are multiple
 136     # ILLSTATUS authorised values with the same authorised_value column value
 137     # so we just use the first
 138     return Koha::AuthorisedValues->search({
 139         branchcode => $self->branchcode,
 140         category => 'ILLSTATUS',
 141         authorised_value => $self->SUPER::status_alias
 142     })->next;
 143 }
 144
 145 =head3 illrequestattributes
 146
 147 =cut
 148
 149 sub illrequestattributes {
 150     my ( $self ) = @_;
 151     return Koha::Illrequestattributes->_new_from_dbic(
 152         scalar $self->_result->illrequestattributes
 153     );
 154 }
 155
 156 =head3 illcomments
 157
 158 =cut
 159
 160 sub illcomments {
 161     my ( $self ) = @_;
 162     return Koha::Illcomments->_new_from_dbic(
 163         scalar $self->_result->illcomments
 164     );
 165 }
 166
 167 =head3 logs
 168
 169 =cut
 170
 171 sub logs {
 172     my ( $self ) = @_;
 173     my $logger = Koha::Illrequest::Logger->new;
 174     return $logger->get_request_logs($self);
 175 }
 176
 177 =head3 patron
 178
 179 =cut
 180
 181 sub patron {
 182     my ( $self ) = @_;
 183     return Koha::Patron->_new_from_dbic(
 184         scalar $self->_result->borrowernumber
 185     );
 186 }
 187
 188 =head3 status_alias
 189
 190     $Illrequest->status_alias(143);
 191
 192 Overloaded getter/setter for status_alias,
 193 that only returns authorised values from the
 194 correct category and records the fact that the status has changed
 195
 196 =cut
 197
 198 sub status_alias {
 199     my ($self, $new_status_alias) = @_;
 200
 201     my $current_status_alias = $self->SUPER::status_alias;
 202
 203     if ($new_status_alias) {
 204         # Keep a record of the previous status before we change it,
 205         # we might need it
 206         $self->{previous_status} = $current_status_alias ?
 207             $current_status_alias :
 208             scalar $self->status;
 209         # This is hackery to enable us to undefine
 210         # status_alias, since we need to have an overloaded
 211         # status_alias method to get us around the problem described
 212         # here:
 213         # https://bugs.koha-community.org/bugzilla3/show_bug.cgi?id=20581#c156
 214         # We need a way of accepting implied undef, so we can nullify
 215         # the status_alias column, when called from $self->status
 216         my $val = $new_status_alias eq "-1" ? undef : $new_status_alias;
 217         my $ret = $self->SUPER::status_alias($val);
 218         my $val_to_log = $val ? $new_status_alias : scalar $self->status;
 219         if ($ret) {
 220             my $logger = Koha::Illrequest::Logger->new;
 221             $logger->log_status_change({
 222                 request => $self,
 223                 value   => $val_to_log
 224             });
 225         } else {
 226             delete $self->{previous_status};
 227         }
 228         return $ret;
 229     }
 230     # We can't know which result is the right one if there are multiple
 231     # ILLSTATUS authorised values with the same authorised_value column value
 232     # so we just use the first
 233     my $alias = Koha::AuthorisedValues->search({
 234         branchcode => $self->branchcode,
 235         category => 'ILLSTATUS',
 236         authorised_value => $self->SUPER::status_alias
 237     })->next;
 238     if ($alias) {
 239         return $alias->authorised_value;
 240     } else {
 241         return;
 242     }
 243 }
 244
 245 =head3 status
 246
 247     $Illrequest->status('CANREQ');
 248
 249 Overloaded getter/setter for request status,
 250 also nullifies status_alias and records the fact that the status has changed
 251
 252 =cut
 253
 254 sub status {
 255     my ( $self, $new_status) = @_;
 256
 257     my $current_status = $self->SUPER::status;
 258     my $current_status_alias = $self->SUPER::status_alias;
 259
 260     if ($new_status) {
 261         # Keep a record of the previous status before we change it,
 262         # we might need it
 263         $self->{previous_status} = $current_status_alias ?
 264             $current_status_alias :
 265             $current_status;
 266         my $ret = $self->SUPER::status($new_status)->store;
 267         if ($current_status_alias) {
 268             # This is hackery to enable us to undefine
 269             # status_alias, since we need to have an overloaded
 270             # status_alias method to get us around the problem described
 271             # here:
 272             # https://bugs.koha-community.org/bugzilla3/show_bug.cgi?id=20581#c156
 273             # We need a way of passing implied undef to nullify status_alias
 274             # so we pass -1, which is special cased in the overloaded setter
 275             $self->status_alias("-1");
 276         } else {
 277             my $logger = Koha::Illrequest::Logger->new;
 278             $logger->log_status_change({
 279                 request => $self,
 280                 value   => $new_status
 281             });
 282         }
 283         delete $self->{previous_status};
 284         return $ret;
 285     } else {
 286         return $current_status;
 287     }
 288 }
 289
 290 =head3 load_backend
 291
 292 Require "Base.pm" from the relevant ILL backend.
 293
 294 =cut
 295
 296 sub load_backend {
 297     my ( $self, $backend_id ) = @_;
 298
 299     my @raw = qw/Koha Illbackends/; # Base Path
 300
 301     my $backend_name = $backend_id || $self->backend;
 302
 303     unless ( defined $backend_name && $backend_name ne '' ) {
 304         Koha::Exceptions::Ill::InvalidBackendId->throw(
 305             "An invalid backend ID was requested ('')");
 306     }
 307
 308     my $location = join "/", @raw, $backend_name, "Base.pm";    # File to load
 309     my $backend_class = join "::", @raw, $backend_name, "Base"; # Package name
 310     require $location;
 311     $self->{_my_backend} = $backend_class->new({
 312         config => $self->_config,
 313         logger => Koha::Illrequest::Logger->new
 314     });
 315     return $self;
 316 }
 317
 318
 319 =head3 _backend
 320
 321     my $backend = $abstract->_backend($new_backend);
 322     my $backend = $abstract->_backend;
 323
 324 Getter/Setter for our API object.
 325
 326 =cut
 327
 328 sub _backend {
 329     my ( $self, $backend ) = @_;
 330     $self->{_my_backend} = $backend if ( $backend );
 331     # Dynamically load our backend object, as late as possible.
 332     $self->load_backend unless ( $self->{_my_backend} );
 333     return $self->{_my_backend};
 334 }
 335
 336 =head3 _backend_capability
 337
 338     my $backend_capability_result = $self->_backend_capability($name, $args);
 339
 340 This is a helper method to invoke optional capabilities in the backend.  If
 341 the capability named by $name is not supported, return 0, else invoke it,
 342 passing $args along with the invocation, and return its return value.
 343
 344 NOTE: this module suffers from a confusion in termninology:
 345
 346 in _backend_capability, the notion of capability refers to an optional feature
 347 that is implemented in core, but might not be supported by a given backend.
 348
 349 in capabilities & custom_capability, capability refers to entries in the
 350 status_graph (after union between backend and core).
 351
 352 The easiest way to fix this would be to fix the terminology in
 353 capabilities & custom_capability and their callers.
 354
 355 =cut
 356
 357 sub _backend_capability {
 358     my ( $self, $name, $args ) = @_;
 359     my $capability = 0;
 360     # See if capability is defined in backend
 361     try {
 362         $capability = $self->_backend->capabilities($name);
 363     } catch {
 364         return 0;
 365     };
 366     # Try to invoke it
 367     if ( $capability && ref($capability) eq 'CODE' ) {
 368         return &{$capability}($args);
 369     } else {
 370         return 0;
 371     }
 372 }
 373
 374 =head3 _config
 375
 376     my $config = $abstract->_config($config);
 377     my $config = $abstract->_config;
 378
 379 Getter/Setter for our config object.
 380
 381 =cut
 382
 383 sub _config {
 384     my ( $self, $config ) = @_;
 385     $self->{_my_config} = $config if ( $config );
 386     # Load our config object, as late as possible.
 387     unless ( $self->{_my_config} ) {
 388         $self->{_my_config} = Koha::Illrequest::Config->new;
 389     }
 390     return $self->{_my_config};
 391 }
 392
 393 =head3 metadata
 394
 395 =cut
 396
 397 sub metadata {
 398     my ( $self ) = @_;
 399     return $self->_backend->metadata($self);
 400 }
 401
 402 =head3 _core_status_graph
 403
 404     my $core_status_graph = $illrequest->_core_status_graph;
 405
 406 Returns ILL module's default status graph.  A status graph defines the list of
 407 available actions at any stage in the ILL workflow.  This is for instance used
 408 by the perl script & template to generate the correct buttons to display to
 409 the end user at any given point.
 410
 411 =cut
 412
 413 sub _core_status_graph {
 414     my ( $self ) = @_;
 415     return {
 416         NEW => {
 417             prev_actions => [ ],                           # Actions containing buttons
 418                                                            # leading to this status
 419             id             => 'NEW',                       # ID of this status
 420             name           => 'New request',               # UI name of this status
 421             ui_method_name => 'New request',               # UI name of method leading
 422                                                            # to this status
 423             method         => 'create',                    # method to this status
 424             next_actions   => [ 'REQ', 'GENREQ', 'KILL' ], # buttons to add to all
 425                                                            # requests with this status
 426             ui_method_icon => 'fa-plus',                   # UI Style class
 427         },
 428         REQ => {
 429             prev_actions   => [ 'NEW', 'REQREV', 'QUEUED', 'CANCREQ' ],
 430             id             => 'REQ',
 431             name           => 'Requested',
 432             ui_method_name => 'Confirm request',
 433             method         => 'confirm',
 434             next_actions   => [ 'REQREV', 'COMP', 'CHK' ],
 435             ui_method_icon => 'fa-check',
 436         },
 437         GENREQ => {
 438             prev_actions   => [ 'NEW', 'REQREV' ],
 439             id             => 'GENREQ',
 440             name           => 'Requested from partners',
 441             ui_method_name => 'Place request with partners',
 442             method         => 'generic_confirm',
 443             next_actions   => [ 'COMP', 'CHK' ],
 444             ui_method_icon => 'fa-send-o',
 445         },
 446         REQREV => {
 447             prev_actions   => [ 'REQ' ],
 448             id             => 'REQREV',
 449             name           => 'Request reverted',
 450             ui_method_name => 'Revert Request',
 451             method         => 'cancel',
 452             next_actions   => [ 'REQ', 'GENREQ', 'KILL' ],
 453             ui_method_icon => 'fa-times',
 454         },
 455         QUEUED => {
 456             prev_actions   => [ ],
 457             id             => 'QUEUED',
 458             name           => 'Queued request',
 459             ui_method_name => 0,
 460             method         => 0,
 461             next_actions   => [ 'REQ', 'KILL' ],
 462             ui_method_icon => 0,
 463         },
 464         CANCREQ => {
 465             prev_actions   => [ 'NEW' ],
 466             id             => 'CANCREQ',
 467             name           => 'Cancellation requested',
 468             ui_method_name => 0,
 469             method         => 0,
 470             next_actions   => [ 'KILL', 'REQ' ],
 471             ui_method_icon => 0,
 472         },
 473         COMP => {
 474             prev_actions   => [ 'REQ' ],
 475             id             => 'COMP',
 476             name           => 'Completed',
 477             ui_method_name => 'Mark completed',
 478             method         => 'mark_completed',
 479             next_actions   => [ 'CHK' ],
 480             ui_method_icon => 'fa-check',
 481         },
 482         KILL => {
 483             prev_actions   => [ 'QUEUED', 'REQREV', 'NEW', 'CANCREQ' ],
 484             id             => 'KILL',
 485             name           => 0,
 486             ui_method_name => 'Delete request',
 487             method         => 'delete',
 488             next_actions   => [ ],
 489             ui_method_icon => 'fa-trash',
 490         },
 491         CHK => {
 492             prev_actions   => [ 'REQ', 'GENREQ', 'COMP' ],
 493             id             => 'CHK',
 494             name           => 'Checked out',
 495             ui_method_name => 'Check out',
 496             method         => 'check_out',
 497             next_actions   => [ ],
 498             ui_method_icon => 'fa-upload',
 499         }
 500     };
 501 }
 502
 503 =head3 _status_graph_union
 504
 505     my $status_graph = $illrequest->_status_graph_union($origin, $new_graph);
 506
 507 Return a new status_graph, the result of merging $origin & new_graph.  This is
 508 operation is a union over the sets defied by the two graphs.
 509
 510 Each entry in $new_graph is added to $origin.  We do not provide a syntax for
 511 'subtraction' of entries from $origin.
 512
 513 Whilst it is not intended that this works, you can override entries in $origin
 514 with entries with the same key in $new_graph.  This can lead to problematic
 515 behaviour when $new_graph adds an entry, which modifies a dependent entry in
 516 $origin, only for the entry in $origin to be replaced later with a new entry
 517 from $new_graph.
 518
 519 NOTE: this procedure does not "re-link" entries in $origin or $new_graph,
 520 i.e. each of the graphs need to be correct at the outset of the operation.
 521
 522 =cut
 523
 524 sub _status_graph_union {
 525     my ( $self, $core_status_graph, $backend_status_graph ) = @_;
 526     # Create new status graph with:
 527     # - all core_status_graph
 528     # - for-each each backend_status_graph
 529     #   + add to new status graph
 530     #   + for each core prev_action:
 531     #     * locate core_status
 532     #     * update next_actions with additional next action.
 533     #   + for each core next_action:
 534     #     * locate core_status
 535     #     * update prev_actions with additional prev action
 536
 537     my @core_status_ids = keys %{$core_status_graph};
 538     my $status_graph = clone($core_status_graph);
 539
 540     foreach my $backend_status_key ( keys %{$backend_status_graph} ) {
 541         my $backend_status = $backend_status_graph->{$backend_status_key};
 542         # Add to new status graph
 543         $status_graph->{$backend_status_key} = $backend_status;
 544         # Update all core methods' next_actions.
 545         foreach my $prev_action ( @{$backend_status->{prev_actions}} ) {
 546             if ( grep { $prev_action eq $_ } @core_status_ids ) {
 547                 my @next_actions =
 548                      @{$status_graph->{$prev_action}->{next_actions}};
 549                 push @next_actions, $backend_status_key;
 550                 $status_graph->{$prev_action}->{next_actions}
 551                     = \@next_actions;
 552             }
 553         }
 554         # Update all core methods' prev_actions
 555         foreach my $next_action ( @{$backend_status->{next_actions}} ) {
 556             if ( grep { $next_action eq $_ } @core_status_ids ) {
 557                 my @prev_actions =
 558                      @{$status_graph->{$next_action}->{prev_actions}};
 559                 push @prev_actions, $backend_status_key;
 560                 $status_graph->{$next_action}->{prev_actions}
 561                     = \@prev_actions;
 562             }
 563         }
 564     }
 565
 566     return $status_graph;
 567 }
 568
 569 ### Core API methods
 570
 571 =head3 capabilities
 572
 573     my $capabilities = $illrequest->capabilities;
 574
 575 Return a hashref mapping methods to operation names supported by the queried
 576 backend.
 577
 578 Example return value:
 579
 580     { create => "Create Request", confirm => "Progress Request" }
 581
 582 NOTE: this module suffers from a confusion in termninology:
 583
 584 in _backend_capability, the notion of capability refers to an optional feature
 585 that is implemented in core, but might not be supported by a given backend.
 586
 587 in capabilities & custom_capability, capability refers to entries in the
 588 status_graph (after union between backend and core).
 589
 590 The easiest way to fix this would be to fix the terminology in
 591 capabilities & custom_capability and their callers.
 592
 593 =cut
 594
 595 sub capabilities {
 596     my ( $self, $status ) = @_;
 597     # Generate up to date status_graph
 598     my $status_graph = $self->_status_graph_union(
 599         $self->_core_status_graph,
 600         $self->_backend->status_graph({
 601             request => $self,
 602             other   => {}
 603         })
 604     );
 605     # Extract available actions from graph.
 606     return $status_graph->{$status} if $status;
 607     # Or return entire graph.
 608     return $status_graph;
 609 }
 610
 611 =head3 custom_capability
 612
 613 Return the result of invoking $CANDIDATE on this request's backend with
 614 $PARAMS, or 0 if $CANDIDATE is an unknown method on backend.
 615
 616 NOTE: this module suffers from a confusion in termninology:
 617
 618 in _backend_capability, the notion of capability refers to an optional feature
 619 that is implemented in core, but might not be supported by a given backend.
 620
 621 in capabilities & custom_capability, capability refers to entries in the
 622 status_graph (after union between backend and core).
 623
 624 The easiest way to fix this would be to fix the terminology in
 625 capabilities & custom_capability and their callers.
 626
 627 =cut
 628
 629 sub custom_capability {
 630     my ( $self, $candidate, $params ) = @_;
 631     foreach my $capability ( values %{$self->capabilities} ) {
 632         if ( $candidate eq $capability->{method} ) {
 633             my $response =
 634                 $self->_backend->$candidate({
 635                     request    => $self,
 636                     other      => $params,
 637                 });
 638             return $self->expandTemplate($response);
 639         }
 640     }
 641     return 0;
 642 }
 643
 644 =head3 available_backends
 645
 646 Return a list of available backends.
 647
 648 =cut
 649
 650 sub available_backends {
 651     my ( $self, $reduced ) = @_;
 652     my $backends = $self->_config->available_backends($reduced);
 653     return $backends;
 654 }
 655
 656 =head3 available_actions
 657
 658 Return a list of available actions.
 659
 660 =cut
 661
 662 sub available_actions {
 663     my ( $self ) = @_;
 664     my $current_action = $self->capabilities($self->status);
 665     my @available_actions = map { $self->capabilities($_) }
 666         @{$current_action->{next_actions}};
 667     return \@available_actions;
 668 }
 669
 670 =head3 mark_completed
 671
 672 Mark a request as completed (status = COMP).
 673
 674 =cut
 675
 676 sub mark_completed {
 677     my ( $self ) = @_;
 678     $self->status('COMP')->store;
 679     $self->completed(DateTime->now)->store;
 680     return {
 681         error   => 0,
 682         status  => '',
 683         message => '',
 684         method  => 'mark_completed',
 685         stage   => 'commit',
 686         next    => 'illview',
 687     };
 688 }
 689
 690 =head2 backend_migrate
 691
 692 Migrate a request from one backend to another.
 693
 694 =cut
 695
 696 sub backend_migrate {
 697     my ( $self, $params ) = @_;
 698
 699     my $response = $self->_backend_capability('migrate',{
 700             request    => $self,
 701             other      => $params,
 702         });
 703     return $self->expandTemplate($response) if $response;
 704     return $response;
 705 }
 706
 707 =head2 backend_confirm
 708
 709 Confirm a request. The backend handles setting of mandatory fields in the commit stage:
 710
 711 =over
 712
 713 =item * orderid
 714
 715 =item * accessurl, cost (if available).
 716
 717 =back
 718
 719 =cut
 720
 721 sub backend_confirm {
 722     my ( $self, $params ) = @_;
 723
 724     my $response = $self->_backend->confirm({
 725             request    => $self,
 726             other      => $params,
 727         });
 728     return $self->expandTemplate($response);
 729 }
 730
 731 =head3 backend_update_status
 732
 733 =cut
 734
 735 sub backend_update_status {
 736     my ( $self, $params ) = @_;
 737     return $self->expandTemplate($self->_backend->update_status($params));
 738 }
 739
 740 =head3 backend_cancel
 741
 742     my $ILLResponse = $illRequest->backend_cancel;
 743
 744 The standard interface method allowing for request cancellation.
 745
 746 =cut
 747
 748 sub backend_cancel {
 749     my ( $self, $params ) = @_;
 750
 751     my $result = $self->_backend->cancel({
 752         request => $self,
 753         other => $params
 754     });
 755
 756     return $self->expandTemplate($result);
 757 }
 758
 759 =head3 backend_renew
 760
 761     my $renew_response = $illRequest->backend_renew;
 762
 763 The standard interface method allowing for request renewal queries.
 764
 765 =cut
 766
 767 sub backend_renew {
 768     my ( $self ) = @_;
 769     return $self->expandTemplate(
 770         $self->_backend->renew({
 771             request    => $self,
 772         })
 773     );
 774 }
 775
 776 =head3 backend_create
 777
 778     my $create_response = $abstractILL->backend_create($params);
 779
 780 Return an array of Record objects created by querying our backend with
 781 a Search query.
 782
 783 In the context of the other ILL methods, this is a special method: we only
 784 pass it $params, as it does not yet have any other data associated with it.
 785
 786 =cut
 787
 788 sub backend_create {
 789     my ( $self, $params ) = @_;
 790
 791     # Establish whether we need to do a generic copyright clearance.
 792     if ($params->{opac}) {
 793         if ( ( !$params->{stage} || $params->{stage} eq 'init' )
 794                 && C4::Context->preference("ILLModuleCopyrightClearance") ) {
 795             return {
 796                 error   => 0,
 797                 status  => '',
 798                 message => '',
 799                 method  => 'create',
 800                 stage   => 'copyrightclearance',
 801                 value   => {
 802                     other   => $params,
 803                     backend => $self->_backend->name
 804                 }
 805             };
 806         } elsif (     defined $params->{stage}
 807                 && $params->{stage} eq 'copyrightclearance' ) {
 808             $params->{stage} = 'init';
 809         }
 810     }
 811     # First perform API action, then...
 812     my $args = {
 813         request => $self,
 814         other   => $params,
 815     };
 816     my $result = $self->_backend->create($args);
 817
 818     # ... simple case: we're not at 'commit' stage.
 819     my $stage = $result->{stage};
 820     return $self->expandTemplate($result)
 821         unless ( 'commit' eq $stage );
 822
 823     # ... complex case: commit!
 824
 825     # Do we still have space for an ILL or should we queue?
 826     my $permitted = $self->check_limits(
 827         { patron => $self->patron }, { librarycode => $self->branchcode }
 828     );
 829
 830     # Now augment our committed request.
 831
 832     $result->{permitted} = $permitted;             # Queue request?
 833
 834     # This involves...
 835
 836     # ...Updating status!
 837     $self->status('QUEUED')->store unless ( $permitted );
 838
 839     ## Handle Unmediated ILLs
 840
 841     # For the unmediated workflow we only need to delegate to our backend. If
 842     # that backend supports unmediateld_ill, it will do its thing and return a
 843     # proper response.  If it doesn't then _backend_capability returns 0, so
 844     # we keep the current result.
 845     if ( C4::Context->preference("ILLModuleUnmediated") && $permitted ) {
 846         my $unmediated_result = $self->_backend_capability(
 847             'unmediated_ill',
 848             $args
 849         );
 850         $result = $unmediated_result if $unmediated_result;
 851     }
 852
 853     return $self->expandTemplate($result);
 854 }
 855
 856 =head3 expandTemplate
 857
 858     my $params = $abstract->expandTemplate($params);
 859
 860 Return a version of $PARAMS augmented with our required template path.
 861
 862 =cut
 863
 864 sub expandTemplate {
 865     my ( $self, $params ) = @_;
 866     my $backend = $self->_backend->name;
 867     # Generate path to file to load
 868     my $backend_dir = $self->_config->backend_dir;
 869     my $backend_tmpl = join "/", $backend_dir, $backend;
 870     my $intra_tmpl =  join "/", $backend_tmpl, "intra-includes",
 871         ( $params->{method}//q{} ) . ".inc";
 872     my $opac_tmpl =  join "/", $backend_tmpl, "opac-includes",
 873         ( $params->{method}//q{} ) . ".inc";
 874     # Set files to load
 875     $params->{template} = $intra_tmpl;
 876     $params->{opac_template} = $opac_tmpl;
 877     return $params;
 878 }
 879
 880 #### Abstract Imports
 881
 882 =head3 getLimits
 883
 884     my $limit_rules = $abstract->getLimits( {
 885         type  => 'brw_cat' | 'branch',
 886         value => $value
 887     } );
 888
 889 Return the ILL limit rules for the supplied combination of type / value.
 890
 891 As the config may have no rules for this particular type / value combination,
 892 or for the default, we must define fall-back values here.
 893
 894 =cut
 895
 896 sub getLimits {
 897     my ( $self, $params ) = @_;
 898     my $limits = $self->_config->getLimitRules($params->{type});
 899
 900     if (     defined $params->{value}
 901           && defined $limits->{$params->{value}} ) {
 902             return $limits->{$params->{value}};
 903     }
 904     else {
 905         return $limits->{default} || { count => -1, method => 'active' };
 906     }
 907 }
 908
 909 =head3 getPrefix
 910
 911     my $prefix = $abstract->getPrefix( {
 912         branch  => $branch_code
 913     } );
 914
 915 Return the ILL prefix as defined by our $params: either per borrower category,
 916 per branch or the default.
 917
 918 =cut
 919
 920 sub getPrefix {
 921     my ( $self, $params ) = @_;
 922     my $brn_prefixes = $self->_config->getPrefixes();
 923     return $brn_prefixes->{$params->{branch}} || ""; # "the empty prefix"
 924 }
 925
 926 =head3 get_type
 927
 928     my $type = $abstract->get_type();
 929
 930 Return a string representing the material type of this request or undef
 931
 932 =cut
 933
 934 sub get_type {
 935     my ($self) = @_;
 936     my $attr = $self->illrequestattributes->find({ type => 'type'});
 937     return if !$attr;
 938     return $attr->value;
 939 };
 940
 941 #### Illrequests Imports
 942
 943 =head3 check_limits
 944
 945     my $ok = $illRequests->check_limits( {
 946         borrower   => $borrower,
 947         branchcode => 'branchcode' | undef,
 948     } );
 949
 950 Given $PARAMS, a hashref containing a $borrower object and a $branchcode,
 951 see whether we are still able to place ILLs.
 952
 953 LimitRules are derived from koha-conf.xml:
 954  + default limit counts, and counting method
 955  + branch specific limit counts & counting method
 956  + borrower category specific limit counts & counting method
 957  + err on the side of caution: a counting fail will cause fail, even if
 958    the other counts passes.
 959
 960 =cut
 961
 962 sub check_limits {
 963     my ( $self, $params ) = @_;
 964     my $patron     = $params->{patron};
 965     my $branchcode = $params->{librarycode} || $patron->branchcode;
 966
 967     # Establish maximum number of allowed requests
 968     my ( $branch_rules, $brw_rules ) = (
 969         $self->getLimits( {
 970             type => 'branch',
 971             value => $branchcode
 972         } ),
 973         $self->getLimits( {
 974             type => 'brw_cat',
 975             value => $patron->categorycode,
 976         } ),
 977     );
 978     my ( $branch_limit, $brw_limit )
 979         = ( $branch_rules->{count}, $brw_rules->{count} );
 980     # Establish currently existing requests
 981     my ( $branch_count, $brw_count ) = (
 982         $self->_limit_counter(
 983             $branch_rules->{method}, { branchcode => $branchcode }
 984         ),
 985         $self->_limit_counter(
 986             $brw_rules->{method}, { borrowernumber => $patron->borrowernumber }
 987         ),
 988     );
 989
 990     # Compare and return
 991     # A limit of -1 means no limit exists.
 992     # We return blocked if either branch limit or brw limit is reached.
 993     if ( ( $branch_limit != -1 && $branch_limit <= $branch_count )
 994              || ( $brw_limit != -1 && $brw_limit <= $brw_count ) ) {
 995         return 0;
 996     } else {
 997         return 1;
 998     }
 999 }
1000
1001 sub _limit_counter {
1002     my ( $self, $method, $target ) = @_;
1003
1004     # Establish parameters of counts
1005     my $resultset;
1006     if ($method && $method eq 'annual') {
1007         $resultset = Koha::Illrequests->search({
1008             -and => [
1009                 %{$target},
1010                 \"YEAR(placed) = YEAR(NOW())"
1011             ]
1012         });
1013     } else {                    # assume 'active'
1014         # XXX: This status list is ugly. There should be a method in config
1015         # to return these.
1016         my $where = { status => { -not_in => [ 'QUEUED', 'COMP' ] } };
1017         $resultset = Koha::Illrequests->search({ %{$target}, %{$where} });
1018     }
1019
1020     # Fetch counts
1021     return $resultset->count;
1022 }
1023
1024 =head3 requires_moderation
1025
1026     my $status = $illRequest->requires_moderation;
1027
1028 Return the name of the status if moderation by staff is required; or 0
1029 otherwise.
1030
1031 =cut
1032
1033 sub requires_moderation {
1034     my ( $self ) = @_;
1035     my $require_moderation = {
1036         'CANCREQ' => 'CANCREQ',
1037     };
1038     return $require_moderation->{$self->status};
1039 }
1040
1041 =head3 check_out
1042
1043     my $stage_summary = $request->check_out;
1044
1045 Handle the check_out method. The first stage involves gathering the required
1046 data from the user via a form, the second stage creates an item and tries to
1047 issue it to the patron. If successful, it notifies the patron, then it
1048 returns a summary of how things went
1049
1050 =cut
1051
1052 sub check_out {
1053     my ( $self, $params ) = @_;
1054
1055     # Objects required by the template
1056     my $itemtypes = Koha::ItemTypes->search(
1057         {},
1058         { order_by => ['description'] }
1059     );
1060     my $libraries = Koha::Libraries->search(
1061         {},
1062         { order_by => ['branchcode'] }
1063     );
1064     my $biblio = Koha::Biblios->find({
1065         biblionumber => $self->biblio_id
1066     });
1067     # Find all statistical patrons
1068     my $statistical_patrons = Koha::Patrons->search(
1069         { 'category_type' => 'x' },
1070         { join => { 'categorycode' => 'borrowers' } }
1071     );
1072
1073     if (!$params->{stage} || $params->{stage} eq 'init') {
1074         # Present a form to gather the required data
1075         #
1076         # We may be viewing this page having previously tried to issue
1077         # the item (in which case, we may already have created an item)
1078         # so we pass the biblio for this request
1079         return {
1080             method  => 'check_out',
1081             stage   => 'form',
1082             value   => {
1083                 itemtypes   => $itemtypes,
1084                 libraries   => $libraries,
1085                 statistical => $statistical_patrons,
1086                 biblio      => $biblio
1087             }
1088         };
1089     } elsif ($params->{stage} eq 'form') {
1090         # Validate what we've got and return with an error if we fail
1091         my $errors = {};
1092         if (!$params->{item_type} || length $params->{item_type} == 0) {
1093             $errors->{item_type} = 1;
1094         }
1095         if ($params->{inhouse} && length $params->{inhouse} > 0) {
1096             my $patron_count = Koha::Patrons->search({
1097                 cardnumber => $params->{inhouse}
1098             })->count();
1099             if ($patron_count != 1) {
1100                 $errors->{inhouse} = 1;
1101             }
1102         }
1103
1104         # Check we don't have more than one item for this bib,
1105         # if we do, something very odd is going on
1106         # Having 1 is OK, it means we're likely trying to issue
1107         # following a previously failed attempt, the item exists
1108         # so we'll use it
1109         my @items = $biblio->items->as_list;
1110         my $item_count = scalar @items;
1111         if ($item_count > 1) {
1112             $errors->{itemcount} = 1;
1113         }
1114
1115         # Failed validation, go back to the form
1116         if (%{$errors}) {
1117             return {
1118                 method  => 'check_out',
1119                 stage   => 'form',
1120                 value   => {
1121                     params      => $params,
1122                     statistical => $statistical_patrons,
1123                     itemtypes   => $itemtypes,
1124                     libraries   => $libraries,
1125                     biblio      => $biblio,
1126                     errors      => $errors
1127                 }
1128             };
1129         }
1130
1131         # Passed validation
1132         #
1133         # Create an item if one doesn't already exist,
1134         # if one does, use that
1135         my $itemnumber;
1136         if ($item_count == 0) {
1137             my $item_hash = {
1138                 homebranch    => $params->{branchcode},
1139                 holdingbranch => $params->{branchcode},
1140                 location      => $params->{branchcode},
1141                 itype         => $params->{item_type},
1142                 barcode       => 'ILL-' . $self->illrequest_id
1143             };
1144             my (undef, undef, $item_no) =
1145                 AddItem($item_hash, $self->biblio_id);
1146             $itemnumber = $item_no;
1147         } else {
1148             $itemnumber = $items[0]->itemnumber;
1149         }
1150         # Check we have an item before going forward
1151         if (!$itemnumber) {
1152             return {
1153                 method  => 'check_out',
1154                 stage   => 'form',
1155                 value   => {
1156                     params      => $params,
1157                     itemtypes   => $itemtypes,
1158                     libraries   => $libraries,
1159                     statistical => $statistical_patrons,
1160                     errors      => { item_creation => 1 }
1161                 }
1162             };
1163         }
1164
1165         # Do the check out
1166         #
1167         # Gather what we need
1168         my $target_item = Koha::Items->find( $itemnumber );
1169         # Determine who we're issuing to
1170         my $patron = $params->{inhouse} && length $params->{inhouse} > 0 ?
1171             Koha::Patrons->find({ cardnumber => $params->{inhouse} }) :
1172             $self->patron;
1173
1174         my @issue_args = (
1175             $patron,
1176             scalar $target_item->barcode
1177         );
1178         if ($params->{duedate} && length $params->{duedate} > 0) {
1179             push @issue_args, $params->{duedate};
1180         }
1181         # Check if we can check out
1182         my ( $error, $confirm, $alerts, $messages ) =
1183             C4::Circulation::CanBookBeIssued(@issue_args);
1184
1185         # If we got anything back saying we can't check out,
1186         # return it to the template
1187         my $problems = {};
1188         if ( $error && %{$error} ) { $problems->{error} = $error };
1189         if ( $confirm && %{$confirm} ) { $problems->{confirm} = $confirm };
1190         if ( $alerts && %{$alerts} ) { $problems->{alerts} = $alerts };
1191         if ( $messages && %{$messages} ) { $problems->{messages} = $messages };
1192
1193         if (%{$problems}) {
1194             return {
1195                 method  => 'check_out',
1196                 stage   => 'form',
1197                 value   => {
1198                     params           => $params,
1199                     itemtypes        => $itemtypes,
1200                     libraries        => $libraries,
1201                     statistical      => $statistical_patrons,
1202                     patron           => $patron,
1203                     biblio           => $biblio,
1204                     check_out_errors => $problems
1205                 }
1206             };
1207         }
1208
1209         # We can allegedly check out, so make it so
1210         # For some reason, AddIssue requires an unblessed Patron
1211         $issue_args[0] = $patron->unblessed;
1212         my $issue = C4::Circulation::AddIssue(@issue_args);
1213
1214         if ($issue && %{$issue}) {
1215             # Update the request status
1216             $self->status('CHK')->store;
1217             return {
1218                 method  => 'check_out',
1219                 stage   => 'done_check_out',
1220                 value   => {
1221                     params    => $params,
1222                     patron    => $patron,
1223                     check_out => $issue
1224                 }
1225             };
1226         } else {
1227             return {
1228                 method  => 'check_out',
1229                 stage   => 'form',
1230                 value   => {
1231                     params    => $params,
1232                     itemtypes => $itemtypes,
1233                     libraries => $libraries,
1234                     errors    => { item_check_out => 1 }
1235                 }
1236             };
1237         }
1238     }
1239
1240 }
1241
1242 =head3 generic_confirm
1243
1244     my $stage_summary = $illRequest->generic_confirm;
1245
1246 Handle the generic_confirm extended method.  The first stage involves creating
1247 a template email for the end user to edit in the browser.  The second stage
1248 attempts to submit the email.
1249
1250 =cut
1251
1252 sub generic_confirm {
1253     my ( $self, $params ) = @_;
1254     my $branch = Koha::Libraries->find($params->{current_branchcode})
1255         || die "Invalid current branchcode. Are you logged in as the database user?";
1256     if ( !$params->{stage}|| $params->{stage} eq 'init' ) {
1257         my $draft->{subject} = "ILL Request";
1258         $draft->{body} = <<EOF;
1259 Dear Sir/Madam,
1260
1261     We would like to request an interlibrary loan for a title matching the
1262 following description:
1263
1264 EOF
1265
1266         my $details = $self->metadata;
1267         while (my ($title, $value) = each %{$details}) {
1268             $draft->{body} .= "  - " . $title . ": " . $value . "\n"
1269                 if $value;
1270         }
1271         $draft->{body} .= <<EOF;
1272
1273 Please let us know if you are able to supply this to us.
1274
1275 Kind Regards
1276
1277 EOF
1278
1279         my @address = map { $branch->$_ }
1280             qw/ branchname branchaddress1 branchaddress2 branchaddress3
1281                 branchzip branchcity branchstate branchcountry branchphone
1282                 branchemail /;
1283         my $address = "";
1284         foreach my $line ( @address ) {
1285             $address .= $line . "\n" if $line;
1286         }
1287
1288         $draft->{body} .= $address;
1289
1290         my $partners = Koha::Patrons->search({
1291             categorycode => $self->_config->partner_code
1292         });
1293         return {
1294             error   => 0,
1295             status  => '',
1296             message => '',
1297             method  => 'generic_confirm',
1298             stage   => 'draft',
1299             value   => {
1300                 draft    => $draft,
1301                 partners => $partners,
1302             }
1303         };
1304
1305     } elsif ( 'draft' eq $params->{stage} ) {
1306         # Create the to header
1307         my $to = $params->{partners};
1308         if ( defined $to ) {
1309             $to =~ s/^\x00//;       # Strip leading NULLs
1310             $to =~ s/\x00/; /;      # Replace others with '; '
1311         }
1312         Koha::Exceptions::Ill::NoTargetEmail->throw(
1313             "No target email addresses found. Either select at least one partner or check your ILL partner library records.")
1314           if ( !$to );
1315         # Create the from, replyto and sender headers
1316         my $from = $branch->branchemail;
1317         my $replyto = $branch->branchreplyto || $from;
1318         Koha::Exceptions::Ill::NoLibraryEmail->throw(
1319             "Your library has no usable email address. Please set it.")
1320           if ( !$from );
1321
1322         # Create the email
1323         my $message = Koha::Email->new;
1324         my %mail = $message->create_message_headers(
1325             {
1326                 to          => $to,
1327                 from        => $from,
1328                 replyto     => $replyto,
1329                 subject     => Encode::encode( "utf8", $params->{subject} ),
1330                 message     => Encode::encode( "utf8", $params->{body} ),
1331                 contenttype => 'text/plain',
1332             }
1333         );
1334         # Send it
1335         my $result = sendmail(%mail);
1336         if ( $result ) {
1337             $self->status("GENREQ")->store;
1338             $self->_backend_capability(
1339                 'set_requested_partners',
1340                 {
1341                     request => $self,
1342                     to => $to
1343                 }
1344             );
1345             return {
1346                 error   => 0,
1347                 status  => '',
1348                 message => '',
1349                 method  => 'generic_confirm',
1350                 stage   => 'commit',
1351                 next    => 'illview',
1352             };
1353         } else {
1354             return {
1355                 error   => 1,
1356                 status  => 'email_failed',
1357                 message => $Mail::Sendmail::error,
1358                 method  => 'generic_confirm',
1359                 stage   => 'draft',
1360             };
1361         }
1362     } else {
1363         die "Unknown stage, should not have happened."
1364     }
1365 }
1366
1367 =head3 id_prefix
1368
1369     my $prefix = $record->id_prefix;
1370
1371 Return the prefix appropriate for the current Illrequest as derived from the
1372 borrower and branch associated with this request's Status, and the config
1373 file.
1374
1375 =cut
1376
1377 sub id_prefix {
1378     my ( $self ) = @_;
1379     my $prefix = $self->getPrefix( {
1380         branch  => $self->branchcode,
1381     } );
1382     $prefix .= "-" if ( $prefix );
1383     return $prefix;
1384 }
1385
1386 =head3 _censor
1387
1388     my $params = $illRequest->_censor($params);
1389
1390 Return $params, modified to reflect our censorship requirements.
1391
1392 =cut
1393
1394 sub _censor {
1395     my ( $self, $params ) = @_;
1396     my $censorship = $self->_config->censorship;
1397     $params->{censor_notes_staff} = $censorship->{censor_notes_staff}
1398         if ( $params->{opac} );
1399     $params->{display_reply_date} = ( $censorship->{censor_reply_date} ) ? 0 : 1;
1400
1401     return $params;
1402 }
1403
1404 =head3 store
1405
1406     $Illrequest->store;
1407
1408 Overloaded I<store> method that, in addition to performing the 'store',
1409 possibly records the fact that something happened
1410
1411 =cut
1412
1413 sub store {
1414     my ( $self, $attrs ) = @_;
1415
1416     my $ret = $self->SUPER::store;
1417
1418     $attrs->{log_origin} = 'core';
1419
1420     if ($ret && defined $attrs) {
1421         my $logger = Koha::Illrequest::Logger->new;
1422         $logger->log_maybe({
1423             request => $self,
1424             attrs   => $attrs
1425         });
1426     }
1427
1428     return $ret;
1429 }
1430
1431 =head3 requested_partners
1432
1433     my $partners_string = $illRequest->requested_partners;
1434
1435 Return the string representing the email addresses of the partners to
1436 whom a request has been sent
1437
1438 =cut
1439
1440 sub requested_partners {
1441     my ( $self ) = @_;
1442     return $self->_backend_capability(
1443         'get_requested_partners',
1444         { request => $self }
1445     );
1446 }
1447
1448 =head3 TO_JSON
1449
1450     $json = $illrequest->TO_JSON
1451
1452 Overloaded I<TO_JSON> method that takes care of inserting calculated values
1453 into the unblessed representation of the object.
1454
1455 TODO: This method does nothing and is not called anywhere. However, bug 74325
1456 touches it, so keeping this for now until both this and bug 74325 are merged,
1457 at which point we can sort it out and remove it completely
1458
1459 =cut
1460
1461 sub TO_JSON {
1462     my ( $self, $embed ) = @_;
1463
1464     my $object = $self->SUPER::TO_JSON();
1465
1466     return $object;
1467 }
1468
1469 =head2 Internal methods
1470
1471 =head3 _type
1472
1473 =cut
1474
1475 sub _type {
1476     return 'Illrequest';
1477 }
1478
1479 =head1 AUTHOR
1480
1481 Alex Sassmannshausen <alex.sassmannshausen@ptfs-europe.com>
1482 Andrew Isherwood <andrew.isherwood@ptfs-europe.com>
1483
1484 =cut
1485
1486 1;