Koha/Illrequest.pm

   1 package Koha::Illrequest;
   2
   3 # Copyright PTFS Europe 2016
   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
  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     try {
 355         $capability = $self->_backend->capabilities($name);
 356     } catch {
 357         return 0;
 358     };
 359     if ( $capability ) {
 360         return &{$capability}($args);
 361     } else {
 362         return 0;
 363     }
 364 }
 365
 366 =head3 _config
 367
 368     my $config = $abstract->_config($config);
 369     my $config = $abstract->_config;
 370
 371 Getter/Setter for our config object.
 372
 373 =cut
 374
 375 sub _config {
 376     my ( $self, $config ) = @_;
 377     $self->{_my_config} = $config if ( $config );
 378     # Load our config object, as late as possible.
 379     unless ( $self->{_my_config} ) {
 380         $self->{_my_config} = Koha::Illrequest::Config->new;
 381     }
 382     return $self->{_my_config};
 383 }
 384
 385 =head3 metadata
 386
 387 =cut
 388
 389 sub metadata {
 390     my ( $self ) = @_;
 391     return $self->_backend->metadata($self);
 392 }
 393
 394 =head3 _core_status_graph
 395
 396     my $core_status_graph = $illrequest->_core_status_graph;
 397
 398 Returns ILL module's default status graph.  A status graph defines the list of
 399 available actions at any stage in the ILL workflow.  This is for instance used
 400 by the perl script & template to generate the correct buttons to display to
 401 the end user at any given point.
 402
 403 =cut
 404
 405 sub _core_status_graph {
 406     my ( $self ) = @_;
 407     return {
 408         NEW => {
 409             prev_actions => [ ],                           # Actions containing buttons
 410                                                            # leading to this status
 411             id             => 'NEW',                       # ID of this status
 412             name           => 'New request',               # UI name of this status
 413             ui_method_name => 'New request',               # UI name of method leading
 414                                                            # to this status
 415             method         => 'create',                    # method to this status
 416             next_actions   => [ 'REQ', 'GENREQ', 'KILL' ], # buttons to add to all
 417                                                            # requests with this status
 418             ui_method_icon => 'fa-plus',                   # UI Style class
 419         },
 420         REQ => {
 421             prev_actions   => [ 'NEW', 'REQREV', 'QUEUED', 'CANCREQ' ],
 422             id             => 'REQ',
 423             name           => 'Requested',
 424             ui_method_name => 'Confirm request',
 425             method         => 'confirm',
 426             next_actions   => [ 'REQREV', 'COMP' ],
 427             ui_method_icon => 'fa-check',
 428         },
 429         GENREQ => {
 430             prev_actions   => [ 'NEW', 'REQREV' ],
 431             id             => 'GENREQ',
 432             name           => 'Requested from partners',
 433             ui_method_name => 'Place request with partners',
 434             method         => 'generic_confirm',
 435             next_actions   => [ 'COMP' ],
 436             ui_method_icon => 'fa-send-o',
 437         },
 438         REQREV => {
 439             prev_actions   => [ 'REQ' ],
 440             id             => 'REQREV',
 441             name           => 'Request reverted',
 442             ui_method_name => 'Revert Request',
 443             method         => 'cancel',
 444             next_actions   => [ 'REQ', 'GENREQ', 'KILL' ],
 445             ui_method_icon => 'fa-times',
 446         },
 447         QUEUED => {
 448             prev_actions   => [ ],
 449             id             => 'QUEUED',
 450             name           => 'Queued request',
 451             ui_method_name => 0,
 452             method         => 0,
 453             next_actions   => [ 'REQ', 'KILL' ],
 454             ui_method_icon => 0,
 455         },
 456         CANCREQ => {
 457             prev_actions   => [ 'NEW' ],
 458             id             => 'CANCREQ',
 459             name           => 'Cancellation requested',
 460             ui_method_name => 0,
 461             method         => 0,
 462             next_actions   => [ 'KILL', 'REQ' ],
 463             ui_method_icon => 0,
 464         },
 465         COMP => {
 466             prev_actions   => [ 'REQ' ],
 467             id             => 'COMP',
 468             name           => 'Completed',
 469             ui_method_name => 'Mark completed',
 470             method         => 'mark_completed',
 471             next_actions   => [ ],
 472             ui_method_icon => 'fa-check',
 473         },
 474         KILL => {
 475             prev_actions   => [ 'QUEUED', 'REQREV', 'NEW', 'CANCREQ' ],
 476             id             => 'KILL',
 477             name           => 0,
 478             ui_method_name => 'Delete request',
 479             method         => 'delete',
 480             next_actions   => [ ],
 481             ui_method_icon => 'fa-trash',
 482         },
 483     };
 484 }
 485
 486 =head3 _core_status_graph
 487
 488     my $status_graph = $illrequest->_core_status_graph($origin, $new_graph);
 489
 490 Return a new status_graph, the result of merging $origin & new_graph.  This is
 491 operation is a union over the sets defied by the two graphs.
 492
 493 Each entry in $new_graph is added to $origin.  We do not provide a syntax for
 494 'subtraction' of entries from $origin.
 495
 496 Whilst it is not intended that this works, you can override entries in $origin
 497 with entries with the same key in $new_graph.  This can lead to problematic
 498 behaviour when $new_graph adds an entry, which modifies a dependent entry in
 499 $origin, only for the entry in $origin to be replaced later with a new entry
 500 from $new_graph.
 501
 502 NOTE: this procedure does not "re-link" entries in $origin or $new_graph,
 503 i.e. each of the graphs need to be correct at the outset of the operation.
 504
 505 =cut
 506
 507 sub _status_graph_union {
 508     my ( $self, $core_status_graph, $backend_status_graph ) = @_;
 509     # Create new status graph with:
 510     # - all core_status_graph
 511     # - for-each each backend_status_graph
 512     #   + add to new status graph
 513     #   + for each core prev_action:
 514     #     * locate core_status
 515     #     * update next_actions with additional next action.
 516     #   + for each core next_action:
 517     #     * locate core_status
 518     #     * update prev_actions with additional prev action
 519
 520     my @core_status_ids = keys %{$core_status_graph};
 521     my $status_graph = clone($core_status_graph);
 522
 523     foreach my $backend_status_key ( keys %{$backend_status_graph} ) {
 524         my $backend_status = $backend_status_graph->{$backend_status_key};
 525         # Add to new status graph
 526         $status_graph->{$backend_status_key} = $backend_status;
 527         # Update all core methods' next_actions.
 528         foreach my $prev_action ( @{$backend_status->{prev_actions}} ) {
 529             if ( grep $prev_action, @core_status_ids ) {
 530                 my @next_actions =
 531                      @{$status_graph->{$prev_action}->{next_actions}};
 532                 push @next_actions, $backend_status_key;
 533                 $status_graph->{$prev_action}->{next_actions}
 534                     = \@next_actions;
 535             }
 536         }
 537         # Update all core methods' prev_actions
 538         foreach my $next_action ( @{$backend_status->{next_actions}} ) {
 539             if ( grep $next_action, @core_status_ids ) {
 540                 my @prev_actions =
 541                      @{$status_graph->{$next_action}->{prev_actions}};
 542                 push @prev_actions, $backend_status_key;
 543                 $status_graph->{$next_action}->{prev_actions}
 544                     = \@prev_actions;
 545             }
 546         }
 547     }
 548
 549     return $status_graph;
 550 }
 551
 552 ### Core API methods
 553
 554 =head3 capabilities
 555
 556     my $capabilities = $illrequest->capabilities;
 557
 558 Return a hashref mapping methods to operation names supported by the queried
 559 backend.
 560
 561 Example return value:
 562
 563     { create => "Create Request", confirm => "Progress Request" }
 564
 565 NOTE: this module suffers from a confusion in termninology:
 566
 567 in _backend_capability, the notion of capability refers to an optional feature
 568 that is implemented in core, but might not be supported by a given backend.
 569
 570 in capabilities & custom_capability, capability refers to entries in the
 571 status_graph (after union between backend and core).
 572
 573 The easiest way to fix this would be to fix the terminology in
 574 capabilities & custom_capability and their callers.
 575
 576 =cut
 577
 578 sub capabilities {
 579     my ( $self, $status ) = @_;
 580     # Generate up to date status_graph
 581     my $status_graph = $self->_status_graph_union(
 582         $self->_core_status_graph,
 583         $self->_backend->status_graph({
 584             request => $self,
 585             other   => {}
 586         })
 587     );
 588     # Extract available actions from graph.
 589     return $status_graph->{$status} if $status;
 590     # Or return entire graph.
 591     return $status_graph;
 592 }
 593
 594 =head3 custom_capability
 595
 596 Return the result of invoking $CANDIDATE on this request's backend with
 597 $PARAMS, or 0 if $CANDIDATE is an unknown method on backend.
 598
 599 NOTE: this module suffers from a confusion in termninology:
 600
 601 in _backend_capability, the notion of capability refers to an optional feature
 602 that is implemented in core, but might not be supported by a given backend.
 603
 604 in capabilities & custom_capability, capability refers to entries in the
 605 status_graph (after union between backend and core).
 606
 607 The easiest way to fix this would be to fix the terminology in
 608 capabilities & custom_capability and their callers.
 609
 610 =cut
 611
 612 sub custom_capability {
 613     my ( $self, $candidate, $params ) = @_;
 614     foreach my $capability ( values %{$self->capabilities} ) {
 615         if ( $candidate eq $capability->{method} ) {
 616             my $response =
 617                 $self->_backend->$candidate({
 618                     request    => $self,
 619                     other      => $params,
 620                 });
 621             return $self->expandTemplate($response);
 622         }
 623     }
 624     return 0;
 625 }
 626
 627 =head3 available_backends
 628
 629 Return a list of available backends.
 630
 631 =cut
 632
 633 sub available_backends {
 634     my ( $self, $reduced ) = @_;
 635     my $backends = $self->_config->available_backends($reduced);
 636     return $backends;
 637 }
 638
 639 =head3 available_actions
 640
 641 Return a list of available actions.
 642
 643 =cut
 644
 645 sub available_actions {
 646     my ( $self ) = @_;
 647     my $current_action = $self->capabilities($self->status);
 648     my @available_actions = map { $self->capabilities($_) }
 649         @{$current_action->{next_actions}};
 650     return \@available_actions;
 651 }
 652
 653 =head3 mark_completed
 654
 655 Mark a request as completed (status = COMP).
 656
 657 =cut
 658
 659 sub mark_completed {
 660     my ( $self ) = @_;
 661     $self->status('COMP')->store;
 662     return {
 663         error   => 0,
 664         status  => '',
 665         message => '',
 666         method  => 'mark_completed',
 667         stage   => 'commit',
 668         next    => 'illview',
 669     };
 670 }
 671
 672 =head2 backend_migrate
 673
 674 Migrate a request from one backend to another.
 675
 676 =cut
 677
 678 sub backend_migrate {
 679     my ( $self, $params ) = @_;
 680
 681     my $response = $self->_backend_capability('migrate',{
 682             request    => $self,
 683             other      => $params,
 684         });
 685     return $self->expandTemplate($response) if $response;
 686     return $response;
 687 }
 688
 689 =head2 backend_confirm
 690
 691 Confirm a request. The backend handles setting of mandatory fields in the commit stage:
 692
 693 =over
 694
 695 =item * orderid
 696
 697 =item * accessurl, cost (if available).
 698
 699 =back
 700
 701 =cut
 702
 703 sub backend_confirm {
 704     my ( $self, $params ) = @_;
 705
 706     my $response = $self->_backend->confirm({
 707             request    => $self,
 708             other      => $params,
 709         });
 710     return $self->expandTemplate($response);
 711 }
 712
 713 =head3 backend_update_status
 714
 715 =cut
 716
 717 sub backend_update_status {
 718     my ( $self, $params ) = @_;
 719     return $self->expandTemplate($self->_backend->update_status($params));
 720 }
 721
 722 =head3 backend_cancel
 723
 724     my $ILLResponse = $illRequest->backend_cancel;
 725
 726 The standard interface method allowing for request cancellation.
 727
 728 =cut
 729
 730 sub backend_cancel {
 731     my ( $self, $params ) = @_;
 732
 733     my $result = $self->_backend->cancel({
 734         request => $self,
 735         other => $params
 736     });
 737
 738     return $self->expandTemplate($result);
 739 }
 740
 741 =head3 backend_renew
 742
 743     my $renew_response = $illRequest->backend_renew;
 744
 745 The standard interface method allowing for request renewal queries.
 746
 747 =cut
 748
 749 sub backend_renew {
 750     my ( $self ) = @_;
 751     return $self->expandTemplate(
 752         $self->_backend->renew({
 753             request    => $self,
 754         })
 755     );
 756 }
 757
 758 =head3 backend_create
 759
 760     my $create_response = $abstractILL->backend_create($params);
 761
 762 Return an array of Record objects created by querying our backend with
 763 a Search query.
 764
 765 In the context of the other ILL methods, this is a special method: we only
 766 pass it $params, as it does not yet have any other data associated with it.
 767
 768 =cut
 769
 770 sub backend_create {
 771     my ( $self, $params ) = @_;
 772
 773     # Establish whether we need to do a generic copyright clearance.
 774     if ($params->{opac}) {
 775         if ( ( !$params->{stage} || $params->{stage} eq 'init' )
 776                 && C4::Context->preference("ILLModuleCopyrightClearance") ) {
 777             return {
 778                 error   => 0,
 779                 status  => '',
 780                 message => '',
 781                 method  => 'create',
 782                 stage   => 'copyrightclearance',
 783                 value   => {
 784                     backend => $self->_backend->name
 785                 }
 786             };
 787         } elsif (     defined $params->{stage}
 788                 && $params->{stage} eq 'copyrightclearance' ) {
 789             $params->{stage} = 'init';
 790         }
 791     }
 792     # First perform API action, then...
 793     my $args = {
 794         request => $self,
 795         other   => $params,
 796     };
 797     my $result = $self->_backend->create($args);
 798
 799     # ... simple case: we're not at 'commit' stage.
 800     my $stage = $result->{stage};
 801     return $self->expandTemplate($result)
 802         unless ( 'commit' eq $stage );
 803
 804     # ... complex case: commit!
 805
 806     # Do we still have space for an ILL or should we queue?
 807     my $permitted = $self->check_limits(
 808         { patron => $self->patron }, { librarycode => $self->branchcode }
 809     );
 810
 811     # Now augment our committed request.
 812
 813     $result->{permitted} = $permitted;             # Queue request?
 814
 815     # This involves...
 816
 817     # ...Updating status!
 818     $self->status('QUEUED')->store unless ( $permitted );
 819
 820     return $self->expandTemplate($result);
 821 }
 822
 823 =head3 expandTemplate
 824
 825     my $params = $abstract->expandTemplate($params);
 826
 827 Return a version of $PARAMS augmented with our required template path.
 828
 829 =cut
 830
 831 sub expandTemplate {
 832     my ( $self, $params ) = @_;
 833     my $backend = $self->_backend->name;
 834     # Generate path to file to load
 835     my $backend_dir = $self->_config->backend_dir;
 836     my $backend_tmpl = join "/", $backend_dir, $backend;
 837     my $intra_tmpl =  join "/", $backend_tmpl, "intra-includes",
 838         $params->{method} . ".inc";
 839     my $opac_tmpl =  join "/", $backend_tmpl, "opac-includes",
 840         $params->{method} . ".inc";
 841     # Set files to load
 842     $params->{template} = $intra_tmpl;
 843     $params->{opac_template} = $opac_tmpl;
 844     return $params;
 845 }
 846
 847 #### Abstract Imports
 848
 849 =head3 getLimits
 850
 851     my $limit_rules = $abstract->getLimits( {
 852         type  => 'brw_cat' | 'branch',
 853         value => $value
 854     } );
 855
 856 Return the ILL limit rules for the supplied combination of type / value.
 857
 858 As the config may have no rules for this particular type / value combination,
 859 or for the default, we must define fall-back values here.
 860
 861 =cut
 862
 863 sub getLimits {
 864     my ( $self, $params ) = @_;
 865     my $limits = $self->_config->getLimitRules($params->{type});
 866
 867     if (     defined $params->{value}
 868           && defined $limits->{$params->{value}} ) {
 869             return $limits->{$params->{value}};
 870     }
 871     else {
 872         return $limits->{default} || { count => -1, method => 'active' };
 873     }
 874 }
 875
 876 =head3 getPrefix
 877
 878     my $prefix = $abstract->getPrefix( {
 879         branch  => $branch_code
 880     } );
 881
 882 Return the ILL prefix as defined by our $params: either per borrower category,
 883 per branch or the default.
 884
 885 =cut
 886
 887 sub getPrefix {
 888     my ( $self, $params ) = @_;
 889     my $brn_prefixes = $self->_config->getPrefixes();
 890     return $brn_prefixes->{$params->{branch}} || ""; # "the empty prefix"
 891 }
 892
 893 =head3 get_type
 894
 895     my $type = $abstract->get_type();
 896
 897 Return a string representing the material type of this request or undef
 898
 899 =cut
 900
 901 sub get_type {
 902     my ($self) = @_;
 903     my $attr = $self->illrequestattributes->find({ type => 'type'});
 904     return if !$attr;
 905     return $attr->value;
 906 };
 907
 908 #### Illrequests Imports
 909
 910 =head3 check_limits
 911
 912     my $ok = $illRequests->check_limits( {
 913         borrower   => $borrower,
 914         branchcode => 'branchcode' | undef,
 915     } );
 916
 917 Given $PARAMS, a hashref containing a $borrower object and a $branchcode,
 918 see whether we are still able to place ILLs.
 919
 920 LimitRules are derived from koha-conf.xml:
 921  + default limit counts, and counting method
 922  + branch specific limit counts & counting method
 923  + borrower category specific limit counts & counting method
 924  + err on the side of caution: a counting fail will cause fail, even if
 925    the other counts passes.
 926
 927 =cut
 928
 929 sub check_limits {
 930     my ( $self, $params ) = @_;
 931     my $patron     = $params->{patron};
 932     my $branchcode = $params->{librarycode} || $patron->branchcode;
 933
 934     # Establish maximum number of allowed requests
 935     my ( $branch_rules, $brw_rules ) = (
 936         $self->getLimits( {
 937             type => 'branch',
 938             value => $branchcode
 939         } ),
 940         $self->getLimits( {
 941             type => 'brw_cat',
 942             value => $patron->categorycode,
 943         } ),
 944     );
 945     my ( $branch_limit, $brw_limit )
 946         = ( $branch_rules->{count}, $brw_rules->{count} );
 947     # Establish currently existing requests
 948     my ( $branch_count, $brw_count ) = (
 949         $self->_limit_counter(
 950             $branch_rules->{method}, { branchcode => $branchcode }
 951         ),
 952         $self->_limit_counter(
 953             $brw_rules->{method}, { borrowernumber => $patron->borrowernumber }
 954         ),
 955     );
 956
 957     # Compare and return
 958     # A limit of -1 means no limit exists.
 959     # We return blocked if either branch limit or brw limit is reached.
 960     if ( ( $branch_limit != -1 && $branch_limit <= $branch_count )
 961              || ( $brw_limit != -1 && $brw_limit <= $brw_count ) ) {
 962         return 0;
 963     } else {
 964         return 1;
 965     }
 966 }
 967
 968 sub _limit_counter {
 969     my ( $self, $method, $target ) = @_;
 970
 971     # Establish parameters of counts
 972     my $resultset;
 973     if ($method && $method eq 'annual') {
 974         $resultset = Koha::Illrequests->search({
 975             -and => [
 976                 %{$target},
 977                 \"YEAR(placed) = YEAR(NOW())"
 978             ]
 979         });
 980     } else {                    # assume 'active'
 981         # XXX: This status list is ugly. There should be a method in config
 982         # to return these.
 983         my $where = { status => { -not_in => [ 'QUEUED', 'COMP' ] } };
 984         $resultset = Koha::Illrequests->search({ %{$target}, %{$where} });
 985     }
 986
 987     # Fetch counts
 988     return $resultset->count;
 989 }
 990
 991 =head3 requires_moderation
 992
 993     my $status = $illRequest->requires_moderation;
 994
 995 Return the name of the status if moderation by staff is required; or 0
 996 otherwise.
 997
 998 =cut
 999
1000 sub requires_moderation {
1001     my ( $self ) = @_;
1002     my $require_moderation = {
1003         'CANCREQ' => 'CANCREQ',
1004     };
1005     return $require_moderation->{$self->status};
1006 }
1007
1008 =head3 generic_confirm
1009
1010     my $stage_summary = $illRequest->generic_confirm;
1011
1012 Handle the generic_confirm extended method.  The first stage involves creating
1013 a template email for the end user to edit in the browser.  The second stage
1014 attempts to submit the email.
1015
1016 =cut
1017
1018 sub generic_confirm {
1019     my ( $self, $params ) = @_;
1020     my $branch = Koha::Libraries->find($params->{current_branchcode})
1021         || die "Invalid current branchcode. Are you logged in as the database user?";
1022     if ( !$params->{stage}|| $params->{stage} eq 'init' ) {
1023         my $draft->{subject} = "ILL Request";
1024         $draft->{body} = <<EOF;
1025 Dear Sir/Madam,
1026
1027     We would like to request an interlibrary loan for a title matching the
1028 following description:
1029
1030 EOF
1031
1032         my $details = $self->metadata;
1033         while (my ($title, $value) = each %{$details}) {
1034             $draft->{body} .= "  - " . $title . ": " . $value . "\n"
1035                 if $value;
1036         }
1037         $draft->{body} .= <<EOF;
1038
1039 Please let us know if you are able to supply this to us.
1040
1041 Kind Regards
1042
1043 EOF
1044
1045         my @address = map { $branch->$_ }
1046             qw/ branchname branchaddress1 branchaddress2 branchaddress3
1047                 branchzip branchcity branchstate branchcountry branchphone
1048                 branchemail /;
1049         my $address = "";
1050         foreach my $line ( @address ) {
1051             $address .= $line . "\n" if $line;
1052         }
1053
1054         $draft->{body} .= $address;
1055
1056         my $partners = Koha::Patrons->search({
1057             categorycode => $self->_config->partner_code
1058         });
1059         return {
1060             error   => 0,
1061             status  => '',
1062             message => '',
1063             method  => 'generic_confirm',
1064             stage   => 'draft',
1065             value   => {
1066                 draft    => $draft,
1067                 partners => $partners,
1068             }
1069         };
1070
1071     } elsif ( 'draft' eq $params->{stage} ) {
1072         # Create the to header
1073         my $to = $params->{partners};
1074         if ( defined $to ) {
1075             $to =~ s/^\x00//;       # Strip leading NULLs
1076             $to =~ s/\x00/; /;      # Replace others with '; '
1077         }
1078         Koha::Exceptions::Ill::NoTargetEmail->throw(
1079             "No target email addresses found. Either select at least one partner or check your ILL partner library records.")
1080           if ( !$to );
1081         # Create the from, replyto and sender headers
1082         my $from = $branch->branchemail;
1083         my $replyto = $branch->branchreplyto || $from;
1084         Koha::Exceptions::Ill::NoLibraryEmail->throw(
1085             "Your library has no usable email address. Please set it.")
1086           if ( !$from );
1087
1088         # Create the email
1089         my $message = Koha::Email->new;
1090         my %mail = $message->create_message_headers(
1091             {
1092                 to          => $to,
1093                 from        => $from,
1094                 replyto     => $replyto,
1095                 subject     => Encode::encode( "utf8", $params->{subject} ),
1096                 message     => Encode::encode( "utf8", $params->{body} ),
1097                 contenttype => 'text/plain',
1098             }
1099         );
1100         # Send it
1101         my $result = sendmail(%mail);
1102         if ( $result ) {
1103             $self->status("GENREQ")->store;
1104             return {
1105                 error   => 0,
1106                 status  => '',
1107                 message => '',
1108                 method  => 'generic_confirm',
1109                 stage   => 'commit',
1110                 next    => 'illview',
1111             };
1112         } else {
1113             return {
1114                 error   => 1,
1115                 status  => 'email_failed',
1116                 message => $Mail::Sendmail::error,
1117                 method  => 'generic_confirm',
1118                 stage   => 'draft',
1119             };
1120         }
1121     } else {
1122         die "Unknown stage, should not have happened."
1123     }
1124 }
1125
1126 =head3 id_prefix
1127
1128     my $prefix = $record->id_prefix;
1129
1130 Return the prefix appropriate for the current Illrequest as derived from the
1131 borrower and branch associated with this request's Status, and the config
1132 file.
1133
1134 =cut
1135
1136 sub id_prefix {
1137     my ( $self ) = @_;
1138     my $prefix = $self->getPrefix( {
1139         branch  => $self->branchcode,
1140     } );
1141     $prefix .= "-" if ( $prefix );
1142     return $prefix;
1143 }
1144
1145 =head3 _censor
1146
1147     my $params = $illRequest->_censor($params);
1148
1149 Return $params, modified to reflect our censorship requirements.
1150
1151 =cut
1152
1153 sub _censor {
1154     my ( $self, $params ) = @_;
1155     my $censorship = $self->_config->censorship;
1156     $params->{censor_notes_staff} = $censorship->{censor_notes_staff}
1157         if ( $params->{opac} );
1158     $params->{display_reply_date} = ( $censorship->{censor_reply_date} ) ? 0 : 1;
1159
1160     return $params;
1161 }
1162
1163 =head3 store
1164
1165     $Illrequest->store;
1166
1167 Overloaded I<store> method that, in addition to performing the 'store',
1168 possibly records the fact that something happened
1169
1170 =cut
1171
1172 sub store {
1173     my ( $self, $attrs ) = @_;
1174
1175     my $ret = $self->SUPER::store;
1176
1177     $attrs->{log_origin} = 'core';
1178
1179     if ($ret && defined $attrs) {
1180         my $logger = Koha::Illrequest::Logger->new;
1181         $logger->log_maybe({
1182             request => $self,
1183             attrs   => $attrs
1184         });
1185     }
1186
1187     return $ret;
1188 }
1189
1190 =head3 TO_JSON
1191
1192     $json = $illrequest->TO_JSON
1193
1194 Overloaded I<TO_JSON> method that takes care of inserting calculated values
1195 into the unblessed representation of the object.
1196
1197 TODO: This method does nothing and is not called anywhere. However, bug 74325
1198 touches it, so keeping this for now until both this and bug 74325 are merged,
1199 at which point we can sort it out and remove it completely
1200
1201 =cut
1202
1203 sub TO_JSON {
1204     my ( $self, $embed ) = @_;
1205
1206     my $object = $self->SUPER::TO_JSON();
1207
1208     return $object;
1209 }
1210
1211 =head2 Internal methods
1212
1213 =head3 _type
1214
1215 =cut
1216
1217 sub _type {
1218     return 'Illrequest';
1219 }
1220
1221 =head1 AUTHOR
1222
1223 Alex Sassmannshausen <alex.sassmannshausen@ptfs-europe.com>
1224
1225 =cut
1226
1227 1;