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