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