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