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