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                     backend => $self->_backend->name
 789                 }
 790             };
 791         } elsif (     defined $params->{stage}
 792                 && $params->{stage} eq 'copyrightclearance' ) {
 793             $params->{stage} = 'init';
 794         }
 795     }
 796     # First perform API action, then...
 797     my $args = {
 798         request => $self,
 799         other   => $params,
 800     };
 801     my $result = $self->_backend->create($args);
 802
 803     # ... simple case: we're not at 'commit' stage.
 804     my $stage = $result->{stage};
 805     return $self->expandTemplate($result)
 806         unless ( 'commit' eq $stage );
 807
 808     # ... complex case: commit!
 809
 810     # Do we still have space for an ILL or should we queue?
 811     my $permitted = $self->check_limits(
 812         { patron => $self->patron }, { librarycode => $self->branchcode }
 813     );
 814
 815     # Now augment our committed request.
 816
 817     $result->{permitted} = $permitted;             # Queue request?
 818
 819     # This involves...
 820
 821     # ...Updating status!
 822     $self->status('QUEUED')->store unless ( $permitted );
 823
 824     ## Handle Unmediated ILLs
 825
 826     # For the unmediated workflow we only need to delegate to our backend. If
 827     # that backend supports unmediateld_ill, it will do its thing and return a
 828     # proper response.  If it doesn't then _backend_capability returns 0, so
 829     # we keep the current result.
 830     if ( C4::Context->preference("ILLModuleUnmediated") && $permitted ) {
 831         my $unmediated_result = $self->_backend_capability(
 832             'unmediated_ill',
 833             $args
 834         );
 835         $result = $unmediated_result if $unmediated_result;
 836     }
 837
 838     return $self->expandTemplate($result);
 839 }
 840
 841 =head3 expandTemplate
 842
 843     my $params = $abstract->expandTemplate($params);
 844
 845 Return a version of $PARAMS augmented with our required template path.
 846
 847 =cut
 848
 849 sub expandTemplate {
 850     my ( $self, $params ) = @_;
 851     my $backend = $self->_backend->name;
 852     # Generate path to file to load
 853     my $backend_dir = $self->_config->backend_dir;
 854     my $backend_tmpl = join "/", $backend_dir, $backend;
 855     my $intra_tmpl =  join "/", $backend_tmpl, "intra-includes",
 856         $params->{method} . ".inc";
 857     my $opac_tmpl =  join "/", $backend_tmpl, "opac-includes",
 858         $params->{method} . ".inc";
 859     # Set files to load
 860     $params->{template} = $intra_tmpl;
 861     $params->{opac_template} = $opac_tmpl;
 862     return $params;
 863 }
 864
 865 #### Abstract Imports
 866
 867 =head3 getLimits
 868
 869     my $limit_rules = $abstract->getLimits( {
 870         type  => 'brw_cat' | 'branch',
 871         value => $value
 872     } );
 873
 874 Return the ILL limit rules for the supplied combination of type / value.
 875
 876 As the config may have no rules for this particular type / value combination,
 877 or for the default, we must define fall-back values here.
 878
 879 =cut
 880
 881 sub getLimits {
 882     my ( $self, $params ) = @_;
 883     my $limits = $self->_config->getLimitRules($params->{type});
 884
 885     if (     defined $params->{value}
 886           && defined $limits->{$params->{value}} ) {
 887             return $limits->{$params->{value}};
 888     }
 889     else {
 890         return $limits->{default} || { count => -1, method => 'active' };
 891     }
 892 }
 893
 894 =head3 getPrefix
 895
 896     my $prefix = $abstract->getPrefix( {
 897         branch  => $branch_code
 898     } );
 899
 900 Return the ILL prefix as defined by our $params: either per borrower category,
 901 per branch or the default.
 902
 903 =cut
 904
 905 sub getPrefix {
 906     my ( $self, $params ) = @_;
 907     my $brn_prefixes = $self->_config->getPrefixes();
 908     return $brn_prefixes->{$params->{branch}} || ""; # "the empty prefix"
 909 }
 910
 911 =head3 get_type
 912
 913     my $type = $abstract->get_type();
 914
 915 Return a string representing the material type of this request or undef
 916
 917 =cut
 918
 919 sub get_type {
 920     my ($self) = @_;
 921     my $attr = $self->illrequestattributes->find({ type => 'type'});
 922     return if !$attr;
 923     return $attr->value;
 924 };
 925
 926 #### Illrequests Imports
 927
 928 =head3 check_limits
 929
 930     my $ok = $illRequests->check_limits( {
 931         borrower   => $borrower,
 932         branchcode => 'branchcode' | undef,
 933     } );
 934
 935 Given $PARAMS, a hashref containing a $borrower object and a $branchcode,
 936 see whether we are still able to place ILLs.
 937
 938 LimitRules are derived from koha-conf.xml:
 939  + default limit counts, and counting method
 940  + branch specific limit counts & counting method
 941  + borrower category specific limit counts & counting method
 942  + err on the side of caution: a counting fail will cause fail, even if
 943    the other counts passes.
 944
 945 =cut
 946
 947 sub check_limits {
 948     my ( $self, $params ) = @_;
 949     my $patron     = $params->{patron};
 950     my $branchcode = $params->{librarycode} || $patron->branchcode;
 951
 952     # Establish maximum number of allowed requests
 953     my ( $branch_rules, $brw_rules ) = (
 954         $self->getLimits( {
 955             type => 'branch',
 956             value => $branchcode
 957         } ),
 958         $self->getLimits( {
 959             type => 'brw_cat',
 960             value => $patron->categorycode,
 961         } ),
 962     );
 963     my ( $branch_limit, $brw_limit )
 964         = ( $branch_rules->{count}, $brw_rules->{count} );
 965     # Establish currently existing requests
 966     my ( $branch_count, $brw_count ) = (
 967         $self->_limit_counter(
 968             $branch_rules->{method}, { branchcode => $branchcode }
 969         ),
 970         $self->_limit_counter(
 971             $brw_rules->{method}, { borrowernumber => $patron->borrowernumber }
 972         ),
 973     );
 974
 975     # Compare and return
 976     # A limit of -1 means no limit exists.
 977     # We return blocked if either branch limit or brw limit is reached.
 978     if ( ( $branch_limit != -1 && $branch_limit <= $branch_count )
 979              || ( $brw_limit != -1 && $brw_limit <= $brw_count ) ) {
 980         return 0;
 981     } else {
 982         return 1;
 983     }
 984 }
 985
 986 sub _limit_counter {
 987     my ( $self, $method, $target ) = @_;
 988
 989     # Establish parameters of counts
 990     my $resultset;
 991     if ($method && $method eq 'annual') {
 992         $resultset = Koha::Illrequests->search({
 993             -and => [
 994                 %{$target},
 995                 \"YEAR(placed) = YEAR(NOW())"
 996             ]
 997         });
 998     } else {                    # assume 'active'
 999         # XXX: This status list is ugly. There should be a method in config
1000         # to return these.
1001         my $where = { status => { -not_in => [ 'QUEUED', 'COMP' ] } };
1002         $resultset = Koha::Illrequests->search({ %{$target}, %{$where} });
1003     }
1004
1005     # Fetch counts
1006     return $resultset->count;
1007 }
1008
1009 =head3 requires_moderation
1010
1011     my $status = $illRequest->requires_moderation;
1012
1013 Return the name of the status if moderation by staff is required; or 0
1014 otherwise.
1015
1016 =cut
1017
1018 sub requires_moderation {
1019     my ( $self ) = @_;
1020     my $require_moderation = {
1021         'CANCREQ' => 'CANCREQ',
1022     };
1023     return $require_moderation->{$self->status};
1024 }
1025
1026 =head3 generic_confirm
1027
1028     my $stage_summary = $illRequest->generic_confirm;
1029
1030 Handle the generic_confirm extended method.  The first stage involves creating
1031 a template email for the end user to edit in the browser.  The second stage
1032 attempts to submit the email.
1033
1034 =cut
1035
1036 sub generic_confirm {
1037     my ( $self, $params ) = @_;
1038     my $branch = Koha::Libraries->find($params->{current_branchcode})
1039         || die "Invalid current branchcode. Are you logged in as the database user?";
1040     if ( !$params->{stage}|| $params->{stage} eq 'init' ) {
1041         my $draft->{subject} = "ILL Request";
1042         $draft->{body} = <<EOF;
1043 Dear Sir/Madam,
1044
1045     We would like to request an interlibrary loan for a title matching the
1046 following description:
1047
1048 EOF
1049
1050         my $details = $self->metadata;
1051         while (my ($title, $value) = each %{$details}) {
1052             $draft->{body} .= "  - " . $title . ": " . $value . "\n"
1053                 if $value;
1054         }
1055         $draft->{body} .= <<EOF;
1056
1057 Please let us know if you are able to supply this to us.
1058
1059 Kind Regards
1060
1061 EOF
1062
1063         my @address = map { $branch->$_ }
1064             qw/ branchname branchaddress1 branchaddress2 branchaddress3
1065                 branchzip branchcity branchstate branchcountry branchphone
1066                 branchemail /;
1067         my $address = "";
1068         foreach my $line ( @address ) {
1069             $address .= $line . "\n" if $line;
1070         }
1071
1072         $draft->{body} .= $address;
1073
1074         my $partners = Koha::Patrons->search({
1075             categorycode => $self->_config->partner_code
1076         });
1077         return {
1078             error   => 0,
1079             status  => '',
1080             message => '',
1081             method  => 'generic_confirm',
1082             stage   => 'draft',
1083             value   => {
1084                 draft    => $draft,
1085                 partners => $partners,
1086             }
1087         };
1088
1089     } elsif ( 'draft' eq $params->{stage} ) {
1090         # Create the to header
1091         my $to = $params->{partners};
1092         if ( defined $to ) {
1093             $to =~ s/^\x00//;       # Strip leading NULLs
1094             $to =~ s/\x00/; /;      # Replace others with '; '
1095         }
1096         Koha::Exceptions::Ill::NoTargetEmail->throw(
1097             "No target email addresses found. Either select at least one partner or check your ILL partner library records.")
1098           if ( !$to );
1099         # Create the from, replyto and sender headers
1100         my $from = $branch->branchemail;
1101         my $replyto = $branch->branchreplyto || $from;
1102         Koha::Exceptions::Ill::NoLibraryEmail->throw(
1103             "Your library has no usable email address. Please set it.")
1104           if ( !$from );
1105
1106         # Create the email
1107         my $message = Koha::Email->new;
1108         my %mail = $message->create_message_headers(
1109             {
1110                 to          => $to,
1111                 from        => $from,
1112                 replyto     => $replyto,
1113                 subject     => Encode::encode( "utf8", $params->{subject} ),
1114                 message     => Encode::encode( "utf8", $params->{body} ),
1115                 contenttype => 'text/plain',
1116             }
1117         );
1118         # Send it
1119         my $result = sendmail(%mail);
1120         if ( $result ) {
1121             $self->status("GENREQ")->store;
1122             $self->_backend_capability(
1123                 'set_requested_partners',
1124                 {
1125                     request => $self,
1126                     to => $to
1127                 }
1128             );
1129             return {
1130                 error   => 0,
1131                 status  => '',
1132                 message => '',
1133                 method  => 'generic_confirm',
1134                 stage   => 'commit',
1135                 next    => 'illview',
1136             };
1137         } else {
1138             return {
1139                 error   => 1,
1140                 status  => 'email_failed',
1141                 message => $Mail::Sendmail::error,
1142                 method  => 'generic_confirm',
1143                 stage   => 'draft',
1144             };
1145         }
1146     } else {
1147         die "Unknown stage, should not have happened."
1148     }
1149 }
1150
1151 =head3 id_prefix
1152
1153     my $prefix = $record->id_prefix;
1154
1155 Return the prefix appropriate for the current Illrequest as derived from the
1156 borrower and branch associated with this request's Status, and the config
1157 file.
1158
1159 =cut
1160
1161 sub id_prefix {
1162     my ( $self ) = @_;
1163     my $prefix = $self->getPrefix( {
1164         branch  => $self->branchcode,
1165     } );
1166     $prefix .= "-" if ( $prefix );
1167     return $prefix;
1168 }
1169
1170 =head3 _censor
1171
1172     my $params = $illRequest->_censor($params);
1173
1174 Return $params, modified to reflect our censorship requirements.
1175
1176 =cut
1177
1178 sub _censor {
1179     my ( $self, $params ) = @_;
1180     my $censorship = $self->_config->censorship;
1181     $params->{censor_notes_staff} = $censorship->{censor_notes_staff}
1182         if ( $params->{opac} );
1183     $params->{display_reply_date} = ( $censorship->{censor_reply_date} ) ? 0 : 1;
1184
1185     return $params;
1186 }
1187
1188 =head3 store
1189
1190     $Illrequest->store;
1191
1192 Overloaded I<store> method that, in addition to performing the 'store',
1193 possibly records the fact that something happened
1194
1195 =cut
1196
1197 sub store {
1198     my ( $self, $attrs ) = @_;
1199
1200     my $ret = $self->SUPER::store;
1201
1202     $attrs->{log_origin} = 'core';
1203
1204     if ($ret && defined $attrs) {
1205         my $logger = Koha::Illrequest::Logger->new;
1206         $logger->log_maybe({
1207             request => $self,
1208             attrs   => $attrs
1209         });
1210     }
1211
1212     return $ret;
1213 }
1214
1215 =head3 requested_partners
1216
1217     my $partners_string = $illRequest->requested_partners;
1218
1219 Return the string representing the email addresses of the partners to
1220 whom a request has been sent
1221
1222 =cut
1223
1224 sub requested_partners {
1225     my ( $self ) = @_;
1226     return $self->_backend_capability(
1227         'get_requested_partners',
1228         { request => $self }
1229     );
1230 }
1231
1232 =head3 TO_JSON
1233
1234     $json = $illrequest->TO_JSON
1235
1236 Overloaded I<TO_JSON> method that takes care of inserting calculated values
1237 into the unblessed representation of the object.
1238
1239 TODO: This method does nothing and is not called anywhere. However, bug 74325
1240 touches it, so keeping this for now until both this and bug 74325 are merged,
1241 at which point we can sort it out and remove it completely
1242
1243 =cut
1244
1245 sub TO_JSON {
1246     my ( $self, $embed ) = @_;
1247
1248     my $object = $self->SUPER::TO_JSON();
1249
1250     return $object;
1251 }
1252
1253 =head2 Internal methods
1254
1255 =head3 _type
1256
1257 =cut
1258
1259 sub _type {
1260     return 'Illrequest';
1261 }
1262
1263 =head1 AUTHOR
1264
1265 Alex Sassmannshausen <alex.sassmannshausen@ptfs-europe.com>
1266 Andrew Isherwood <andrew.isherwood@ptfs-europe.com>
1267
1268 =cut
1269
1270 1;