Koha/Illrequest.pm

   1 package Koha::Illrequest;
   2
   3 # Copyright PTFS Europe 2016,2018
   4 #
   5 # This file is part of Koha.
   6 #
   7 # Koha is free software; you can redistribute it and/or modify it
   8 # under the terms of the GNU General Public License as published by
   9 # the Free Software Foundation; either version 3 of the License, or
  10 # (at your option) any later version.
  11 #
  12 # Koha is distributed in the hope that it will be useful, but
  13 # WITHOUT ANY WARRANTY; without even the implied warranty of
  14 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  15 # GNU General Public License for more details.
  16 #
  17 # You should have received a copy of the GNU General Public License
  18 # along with Koha; if not, see <http://www.gnu.org/licenses>.
  19
  20 use Modern::Perl;
  21
  22 use Clone 'clone';
  23 use File::Basename qw( basename );
  24 use Encode qw( encode );
  25 use Mail::Sendmail;
  26 use Try::Tiny;
  27 use DateTime;
  28
  29 use Koha::Database;
  30 use Koha::Email;
  31 use Koha::Exceptions::Ill;
  32 use Koha::Illcomments;
  33 use Koha::Illrequestattributes;
  34 use Koha::AuthorisedValue;
  35 use Koha::Illrequest::Logger;
  36 use Koha::Patron;
  37 use Koha::AuthorisedValues;
  38
  39 use base qw(Koha::Object);
  40
  41 =head1 NAME
  42
  43 Koha::Illrequest - Koha Illrequest Object class
  44
  45 =head1 (Re)Design
  46
  47 An ILLRequest consists of two parts; the Illrequest Koha::Object, and a series
  48 of related Illrequestattributes.
  49
  50 The former encapsulates the basic necessary information that any ILL requires
  51 to be usable in Koha.  The latter is a set of additional properties used by
  52 one of the backends.
  53
  54 The former subsumes the legacy "Status" object.  The latter remains
  55 encapsulated in the "Record" object.
  56
  57 TODO:
  58
  59 - Anything invoking the ->status method; annotated with:
  60   + # Old use of ->status !
  61
  62 =head1 API
  63
  64 =head2 Backend API Response Principles
  65
  66 All methods should return a hashref in the following format:
  67
  68 =over
  69
  70 =item * error
  71
  72 This should be set to 1 if an error was encountered.
  73
  74 =item * status
  75
  76 The status should be a string from the list of statuses detailed below.
  77
  78 =item * message
  79
  80 The message is a free text field that can be passed on to the end user.
  81
  82 =item * value
  83
  84 The value returned by the method.
  85
  86 =back
  87
  88 =head2 Interface Status Messages
  89
  90 =over
  91
  92 =item * branch_address_incomplete
  93
  94 An interface request has determined branch address details are incomplete.
  95
  96 =item * cancel_success
  97
  98 The interface's cancel_request method was successful in cancelling the
  99 Illrequest using the API.
 100
 101 =item * cancel_fail
 102
 103 The interface's cancel_request method failed to cancel the Illrequest using
 104 the API.
 105
 106 =item * unavailable
 107
 108 The interface's request method returned saying that the desired item is not
 109 available for request.
 110
 111 =back
 112
 113 =head2 Class methods
 114
 115 =head3 statusalias
 116
 117     my $statusalias = $request->statusalias;
 118
 119 Returns a request's status alias, as a Koha::AuthorisedValue instance
 120 or implicit undef. This is distinct from status_alias, which only returns
 121 the value in the status_alias column, this method returns the entire
 122 AuthorisedValue object
 123
 124 =cut
 125
 126 sub statusalias {
 127     my ( $self ) = @_;
 128     return unless $self->status_alias;
 129     # We can't know which result is the right one if there are multiple
 130     # ILLSTATUS authorised values with the same authorised_value column value
 131     # so we just use the first
 132     return Koha::AuthorisedValues->search({
 133         branchcode => $self->branchcode,
 134         category => 'ILLSTATUS',
 135         authorised_value => $self->SUPER::status_alias
 136     })->next;
 137 }
 138
 139 =head3 illrequestattributes
 140
 141 =cut
 142
 143 sub illrequestattributes {
 144     my ( $self ) = @_;
 145     return Koha::Illrequestattributes->_new_from_dbic(
 146         scalar $self->_result->illrequestattributes
 147     );
 148 }
 149
 150 =head3 illcomments
 151
 152 =cut
 153
 154 sub illcomments {
 155     my ( $self ) = @_;
 156     return Koha::Illcomments->_new_from_dbic(
 157         scalar $self->_result->illcomments
 158     );
 159 }
 160
 161 =head3 logs
 162
 163 =cut
 164
 165 sub logs {
 166     my ( $self ) = @_;
 167     my $logger = Koha::Illrequest::Logger->new;
 168     return $logger->get_request_logs($self);
 169 }
 170
 171 =head3 patron
 172
 173 =cut
 174
 175 sub patron {
 176     my ( $self ) = @_;
 177     return Koha::Patron->_new_from_dbic(
 178         scalar $self->_result->borrowernumber
 179     );
 180 }
 181
 182 =head3 status_alias
 183
 184     $Illrequest->status_alias(143);
 185
 186 Overloaded getter/setter for status_alias,
 187 that only returns authorised values from the
 188 correct category and records the fact that the status has changed
 189
 190 =cut
 191
 192 sub status_alias {
 193     my ($self, $new_status_alias) = @_;
 194
 195     my $current_status_alias = $self->SUPER::status_alias;
 196
 197     if ($new_status_alias) {
 198         # Keep a record of the previous status before we change it,
 199         # we might need it
 200         $self->{previous_status} = $current_status_alias ?
 201             $current_status_alias :
 202             scalar $self->status;
 203         # This is hackery to enable us to undefine
 204         # status_alias, since we need to have an overloaded
 205         # status_alias method to get us around the problem described
 206         # here:
 207         # https://bugs.koha-community.org/bugzilla3/show_bug.cgi?id=20581#c156
 208         # We need a way of accepting implied undef, so we can nullify
 209         # the status_alias column, when called from $self->status
 210         my $val = $new_status_alias eq "-1" ? undef : $new_status_alias;
 211         my $ret = $self->SUPER::status_alias($val);
 212         my $val_to_log = $val ? $new_status_alias : scalar $self->status;
 213         if ($ret) {
 214             my $logger = Koha::Illrequest::Logger->new;
 215             $logger->log_status_change({
 216                 request => $self,
 217                 value   => $val_to_log
 218             });
 219         } else {
 220             delete $self->{previous_status};
 221         }
 222         return $ret;
 223     }
 224     # We can't know which result is the right one if there are multiple
 225     # ILLSTATUS authorised values with the same authorised_value column value
 226     # so we just use the first
 227     my $alias = Koha::AuthorisedValues->search({
 228         branchcode => $self->branchcode,
 229         category => 'ILLSTATUS',
 230         authorised_value => $self->SUPER::status_alias
 231     })->next;
 232     if ($alias) {
 233         return $alias->authorised_value;
 234     } else {
 235         return;
 236     }
 237 }
 238
 239 =head3 status
 240
 241     $Illrequest->status('CANREQ');
 242
 243 Overloaded getter/setter for request status,
 244 also nullifies status_alias and records the fact that the status has changed
 245
 246 =cut
 247
 248 sub status {
 249     my ( $self, $new_status) = @_;
 250
 251     my $current_status = $self->SUPER::status;
 252     my $current_status_alias = $self->SUPER::status_alias;
 253
 254     if ($new_status) {
 255         # Keep a record of the previous status before we change it,
 256         # we might need it
 257         $self->{previous_status} = $current_status_alias ?
 258             $current_status_alias :
 259             $current_status;
 260         my $ret = $self->SUPER::status($new_status)->store;
 261         if ($current_status_alias) {
 262             # This is hackery to enable us to undefine
 263             # status_alias, since we need to have an overloaded
 264             # status_alias method to get us around the problem described
 265             # here:
 266             # https://bugs.koha-community.org/bugzilla3/show_bug.cgi?id=20581#c156
 267             # We need a way of passing implied undef to nullify status_alias
 268             # so we pass -1, which is special cased in the overloaded setter
 269             $self->status_alias("-1");
 270         } else {
 271             my $logger = Koha::Illrequest::Logger->new;
 272             $logger->log_status_change({
 273                 request => $self,
 274                 value   => $new_status
 275             });
 276         }
 277         delete $self->{previous_status};
 278         return $ret;
 279     } else {
 280         return $current_status;
 281     }
 282 }
 283
 284 =head3 load_backend
 285
 286 Require "Base.pm" from the relevant ILL backend.
 287
 288 =cut
 289
 290 sub load_backend {
 291     my ( $self, $backend_id ) = @_;
 292
 293     my @raw = qw/Koha Illbackends/; # Base Path
 294
 295     my $backend_name = $backend_id || $self->backend;
 296
 297     unless ( defined $backend_name && $backend_name ne '' ) {
 298         Koha::Exceptions::Ill::InvalidBackendId->throw(
 299             "An invalid backend ID was requested ('')");
 300     }
 301
 302     my $location = join "/", @raw, $backend_name, "Base.pm";    # File to load
 303     my $backend_class = join "::", @raw, $backend_name, "Base"; # Package name
 304     require $location;
 305     $self->{_my_backend} = $backend_class->new({
 306         config => $self->_config,
 307         logger => Koha::Illrequest::Logger->new
 308     });
 309     return $self;
 310 }
 311
 312
 313 =head3 _backend
 314
 315     my $backend = $abstract->_backend($new_backend);
 316     my $backend = $abstract->_backend;
 317
 318 Getter/Setter for our API object.
 319
 320 =cut
 321
 322 sub _backend {
 323     my ( $self, $backend ) = @_;
 324     $self->{_my_backend} = $backend if ( $backend );
 325     # Dynamically load our backend object, as late as possible.
 326     $self->load_backend unless ( $self->{_my_backend} );
 327     return $self->{_my_backend};
 328 }
 329
 330 =head3 _backend_capability
 331
 332     my $backend_capability_result = $self->_backend_capability($name, $args);
 333
 334 This is a helper method to invoke optional capabilities in the backend.  If
 335 the capability named by $name is not supported, return 0, else invoke it,
 336 passing $args along with the invocation, and return its return value.
 337
 338 NOTE: this module suffers from a confusion in termninology:
 339
 340 in _backend_capability, the notion of capability refers to an optional feature
 341 that is implemented in core, but might not be supported by a given backend.
 342
 343 in capabilities & custom_capability, capability refers to entries in the
 344 status_graph (after union between backend and core).
 345
 346 The easiest way to fix this would be to fix the terminology in
 347 capabilities & custom_capability and their callers.
 348
 349 =cut
 350
 351 sub _backend_capability {
 352     my ( $self, $name, $args ) = @_;
 353     my $capability = 0;
 354     # See if capability is defined in backend
 355     try {
 356         $capability = $self->_backend->capabilities($name);
 357     } catch {
 358         return 0;
 359     };
 360     # Try to invoke it
 361     if ( $capability && ref($capability) eq 'CODE' ) {
 362         return &{$capability}($args);
 363     } else {
 364         return 0;
 365     }
 366 }
 367
 368 =head3 _config
 369
 370     my $config = $abstract->_config($config);
 371     my $config = $abstract->_config;
 372
 373 Getter/Setter for our config object.
 374
 375 =cut
 376
 377 sub _config {
 378     my ( $self, $config ) = @_;
 379     $self->{_my_config} = $config if ( $config );
 380     # Load our config object, as late as possible.
 381     unless ( $self->{_my_config} ) {
 382         $self->{_my_config} = Koha::Illrequest::Config->new;
 383     }
 384     return $self->{_my_config};
 385 }
 386
 387 =head3 metadata
 388
 389 =cut
 390
 391 sub metadata {
 392     my ( $self ) = @_;
 393     return $self->_backend->metadata($self);
 394 }
 395
 396 =head3 _core_status_graph
 397
 398     my $core_status_graph = $illrequest->_core_status_graph;
 399
 400 Returns ILL module's default status graph.  A status graph defines the list of
 401 available actions at any stage in the ILL workflow.  This is for instance used
 402 by the perl script & template to generate the correct buttons to display to
 403 the end user at any given point.
 404
 405 =cut
 406
 407 sub _core_status_graph {
 408     my ( $self ) = @_;
 409     return {
 410         NEW => {
 411             prev_actions => [ ],                           # Actions containing buttons
 412                                                            # leading to this status
 413             id             => 'NEW',                       # ID of this status
 414             name           => 'New request',               # UI name of this status
 415             ui_method_name => 'New request',               # UI name of method leading
 416                                                            # to this status
 417             method         => 'create',                    # method to this status
 418             next_actions   => [ 'REQ', 'GENREQ', 'KILL' ], # buttons to add to all
 419                                                            # requests with this status
 420             ui_method_icon => 'fa-plus',                   # UI Style class
 421         },
 422         REQ => {
 423             prev_actions   => [ 'NEW', 'REQREV', 'QUEUED', 'CANCREQ' ],
 424             id             => 'REQ',
 425             name           => 'Requested',
 426             ui_method_name => 'Confirm request',
 427             method         => 'confirm',
 428             next_actions   => [ 'REQREV', 'COMP' ],
 429             ui_method_icon => 'fa-check',
 430         },
 431         GENREQ => {
 432             prev_actions   => [ 'NEW', 'REQREV' ],
 433             id             => 'GENREQ',
 434             name           => 'Requested from partners',
 435             ui_method_name => 'Place request with partners',
 436             method         => 'generic_confirm',
 437             next_actions   => [ 'COMP' ],
 438             ui_method_icon => 'fa-send-o',
 439         },
 440         REQREV => {
 441             prev_actions   => [ 'REQ' ],
 442             id             => 'REQREV',
 443             name           => 'Request reverted',
 444             ui_method_name => 'Revert Request',
 445             method         => 'cancel',
 446             next_actions   => [ 'REQ', 'GENREQ', 'KILL' ],
 447             ui_method_icon => 'fa-times',
 448         },
 449         QUEUED => {
 450             prev_actions   => [ ],
 451             id             => 'QUEUED',
 452             name           => 'Queued request',
 453             ui_method_name => 0,
 454             method         => 0,
 455             next_actions   => [ 'REQ', 'KILL' ],
 456             ui_method_icon => 0,
 457         },
 458         CANCREQ => {
 459             prev_actions   => [ 'NEW' ],
 460             id             => 'CANCREQ',
 461             name           => 'Cancellation requested',
 462             ui_method_name => 0,
 463             method         => 0,
 464             next_actions   => [ 'KILL', 'REQ' ],
 465             ui_method_icon => 0,
 466         },
 467         COMP => {
 468             prev_actions   => [ 'REQ' ],
 469             id             => 'COMP',
 470             name           => 'Completed',
 471             ui_method_name => 'Mark completed',
 472             method         => 'mark_completed',
 473             next_actions   => [ ],
 474             ui_method_icon => 'fa-check',
 475         },
 476         KILL => {
 477             prev_actions   => [ 'QUEUED', 'REQREV', 'NEW', 'CANCREQ' ],
 478             id             => 'KILL',
 479             name           => 0,
 480             ui_method_name => 'Delete request',
 481             method         => 'delete',
 482             next_actions   => [ ],
 483             ui_method_icon => 'fa-trash',
 484         },
 485     };
 486 }
 487
 488 =head3 _status_graph_union
 489
 490     my $status_graph = $illrequest->_status_graph_union($origin, $new_graph);
 491
 492 Return a new status_graph, the result of merging $origin & new_graph.  This is
 493 operation is a union over the sets defied by the two graphs.
 494
 495 Each entry in $new_graph is added to $origin.  We do not provide a syntax for
 496 'subtraction' of entries from $origin.
 497
 498 Whilst it is not intended that this works, you can override entries in $origin
 499 with entries with the same key in $new_graph.  This can lead to problematic
 500 behaviour when $new_graph adds an entry, which modifies a dependent entry in
 501 $origin, only for the entry in $origin to be replaced later with a new entry
 502 from $new_graph.
 503
 504 NOTE: this procedure does not "re-link" entries in $origin or $new_graph,
 505 i.e. each of the graphs need to be correct at the outset of the operation.
 506
 507 =cut
 508
 509 sub _status_graph_union {
 510     my ( $self, $core_status_graph, $backend_status_graph ) = @_;
 511     # Create new status graph with:
 512     # - all core_status_graph
 513     # - for-each each backend_status_graph
 514     #   + add to new status graph
 515     #   + for each core prev_action:
 516     #     * locate core_status
 517     #     * update next_actions with additional next action.
 518     #   + for each core next_action:
 519     #     * locate core_status
 520     #     * update prev_actions with additional prev action
 521
 522     my @core_status_ids = keys %{$core_status_graph};
 523     my $status_graph = clone($core_status_graph);
 524
 525     foreach my $backend_status_key ( keys %{$backend_status_graph} ) {
 526         my $backend_status = $backend_status_graph->{$backend_status_key};
 527         # Add to new status graph
 528         $status_graph->{$backend_status_key} = $backend_status;
 529         # Update all core methods' next_actions.
 530         foreach my $prev_action ( @{$backend_status->{prev_actions}} ) {
 531             if ( grep { $prev_action eq $_ } @core_status_ids ) {
 532                 my @next_actions =
 533                      @{$status_graph->{$prev_action}->{next_actions}};
 534                 push @next_actions, $backend_status_key;
 535                 $status_graph->{$prev_action}->{next_actions}
 536                     = \@next_actions;
 537             }
 538         }
 539         # Update all core methods' prev_actions
 540         foreach my $next_action ( @{$backend_status->{next_actions}} ) {
 541             if ( grep { $next_action eq $_ } @core_status_ids ) {
 542                 my @prev_actions =
 543                      @{$status_graph->{$next_action}->{prev_actions}};
 544                 push @prev_actions, $backend_status_key;
 545                 $status_graph->{$next_action}->{prev_actions}
 546                     = \@prev_actions;
 547             }
 548         }
 549     }
 550
 551     return $status_graph;
 552 }
 553
 554 ### Core API methods
 555
 556 =head3 capabilities
 557
 558     my $capabilities = $illrequest->capabilities;
 559
 560 Return a hashref mapping methods to operation names supported by the queried
 561 backend.
 562
 563 Example return value:
 564
 565     { create => "Create Request", confirm => "Progress Request" }
 566
 567 NOTE: this module suffers from a confusion in termninology:
 568
 569 in _backend_capability, the notion of capability refers to an optional feature
 570 that is implemented in core, but might not be supported by a given backend.
 571
 572 in capabilities & custom_capability, capability refers to entries in the
 573 status_graph (after union between backend and core).
 574
 575 The easiest way to fix this would be to fix the terminology in
 576 capabilities & custom_capability and their callers.
 577
 578 =cut
 579
 580 sub capabilities {
 581     my ( $self, $status ) = @_;
 582     # Generate up to date status_graph
 583     my $status_graph = $self->_status_graph_union(
 584         $self->_core_status_graph,
 585         $self->_backend->status_graph({
 586             request => $self,
 587             other   => {}
 588         })
 589     );
 590     # Extract available actions from graph.
 591     return $status_graph->{$status} if $status;
 592     # Or return entire graph.
 593     return $status_graph;
 594 }
 595
 596 =head3 custom_capability
 597
 598 Return the result of invoking $CANDIDATE on this request's backend with
 599 $PARAMS, or 0 if $CANDIDATE is an unknown method on backend.
 600
 601 NOTE: this module suffers from a confusion in termninology:
 602
 603 in _backend_capability, the notion of capability refers to an optional feature
 604 that is implemented in core, but might not be supported by a given backend.
 605
 606 in capabilities & custom_capability, capability refers to entries in the
 607 status_graph (after union between backend and core).
 608
 609 The easiest way to fix this would be to fix the terminology in
 610 capabilities & custom_capability and their callers.
 611
 612 =cut
 613
 614 sub custom_capability {
 615     my ( $self, $candidate, $params ) = @_;
 616     foreach my $capability ( values %{$self->capabilities} ) {
 617         if ( $candidate eq $capability->{method} ) {
 618             my $response =
 619                 $self->_backend->$candidate({
 620                     request    => $self,
 621                     other      => $params,
 622                 });
 623             return $self->expandTemplate($response);
 624         }
 625     }
 626     return 0;
 627 }
 628
 629 =head3 available_backends
 630
 631 Return a list of available backends.
 632
 633 =cut
 634
 635 sub available_backends {
 636     my ( $self, $reduced ) = @_;
 637     my $backends = $self->_config->available_backends($reduced);
 638     return $backends;
 639 }
 640
 641 =head3 available_actions
 642
 643 Return a list of available actions.
 644
 645 =cut
 646
 647 sub available_actions {
 648     my ( $self ) = @_;
 649     my $current_action = $self->capabilities($self->status);
 650     my @available_actions = map { $self->capabilities($_) }
 651         @{$current_action->{next_actions}};
 652     return \@available_actions;
 653 }
 654
 655 =head3 mark_completed
 656
 657 Mark a request as completed (status = COMP).
 658
 659 =cut
 660
 661 sub mark_completed {
 662     my ( $self ) = @_;
 663     $self->status('COMP')->store;
 664     $self->completed(DateTime->now)->store;
 665     return {
 666         error   => 0,
 667         status  => '',
 668         message => '',
 669         method  => 'mark_completed',
 670         stage   => 'commit',
 671         next    => 'illview',
 672     };
 673 }
 674
 675 =head2 backend_migrate
 676
 677 Migrate a request from one backend to another.
 678
 679 =cut
 680
 681 sub backend_migrate {
 682     my ( $self, $params ) = @_;
 683
 684     my $response = $self->_backend_capability('migrate',{
 685             request    => $self,
 686             other      => $params,
 687         });
 688     return $self->expandTemplate($response) if $response;
 689     return $response;
 690 }
 691
 692 =head2 backend_confirm
 693
 694 Confirm a request. The backend handles setting of mandatory fields in the commit stage:
 695
 696 =over
 697
 698 =item * orderid
 699
 700 =item * accessurl, cost (if available).
 701
 702 =back
 703
 704 =cut
 705
 706 sub backend_confirm {
 707     my ( $self, $params ) = @_;
 708
 709     my $response = $self->_backend->confirm({
 710             request    => $self,
 711             other      => $params,
 712         });
 713     return $self->expandTemplate($response);
 714 }
 715
 716 =head3 backend_update_status
 717
 718 =cut
 719
 720 sub backend_update_status {
 721     my ( $self, $params ) = @_;
 722     return $self->expandTemplate($self->_backend->update_status($params));
 723 }
 724
 725 =head3 backend_cancel
 726
 727     my $ILLResponse = $illRequest->backend_cancel;
 728
 729 The standard interface method allowing for request cancellation.
 730
 731 =cut
 732
 733 sub backend_cancel {
 734     my ( $self, $params ) = @_;
 735
 736     my $result = $self->_backend->cancel({
 737         request => $self,
 738         other => $params
 739     });
 740
 741     return $self->expandTemplate($result);
 742 }
 743
 744 =head3 backend_renew
 745
 746     my $renew_response = $illRequest->backend_renew;
 747
 748 The standard interface method allowing for request renewal queries.
 749
 750 =cut
 751
 752 sub backend_renew {
 753     my ( $self ) = @_;
 754     return $self->expandTemplate(
 755         $self->_backend->renew({
 756             request    => $self,
 757         })
 758     );
 759 }
 760
 761 =head3 backend_create
 762
 763     my $create_response = $abstractILL->backend_create($params);
 764
 765 Return an array of Record objects created by querying our backend with
 766 a Search query.
 767
 768 In the context of the other ILL methods, this is a special method: we only
 769 pass it $params, as it does not yet have any other data associated with it.
 770
 771 =cut
 772
 773 sub backend_create {
 774     my ( $self, $params ) = @_;
 775
 776     # Establish whether we need to do a generic copyright clearance.
 777     if ($params->{opac}) {
 778         if ( ( !$params->{stage} || $params->{stage} eq 'init' )
 779                 && C4::Context->preference("ILLModuleCopyrightClearance") ) {
 780             return {
 781                 error   => 0,
 782                 status  => '',
 783                 message => '',
 784                 method  => 'create',
 785                 stage   => 'copyrightclearance',
 786                 value   => {
 787                     other   => $params,
 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}//q{} ) . ".inc";
 857     my $opac_tmpl =  join "/", $backend_tmpl, "opac-includes",
 858         ( $params->{method}//q{} ) . ".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;