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         RET => {
 503             prev_actions   => [ 'CHK' ],
 504             id             => 'RET',
 505             name           => 'Returned to library',
 506             ui_method_name => 'Check in',
 507             method         => 'check_in',
 508             next_actions   => [ 'COMP' ],
 509             ui_method_icon => 'fa-download',
 510         }
 511     };
 512 }
 513
 514 =head3 _status_graph_union
 515
 516     my $status_graph = $illrequest->_status_graph_union($origin, $new_graph);
 517
 518 Return a new status_graph, the result of merging $origin & new_graph.  This is
 519 operation is a union over the sets defied by the two graphs.
 520
 521 Each entry in $new_graph is added to $origin.  We do not provide a syntax for
 522 'subtraction' of entries from $origin.
 523
 524 Whilst it is not intended that this works, you can override entries in $origin
 525 with entries with the same key in $new_graph.  This can lead to problematic
 526 behaviour when $new_graph adds an entry, which modifies a dependent entry in
 527 $origin, only for the entry in $origin to be replaced later with a new entry
 528 from $new_graph.
 529
 530 NOTE: this procedure does not "re-link" entries in $origin or $new_graph,
 531 i.e. each of the graphs need to be correct at the outset of the operation.
 532
 533 =cut
 534
 535 sub _status_graph_union {
 536     my ( $self, $core_status_graph, $backend_status_graph ) = @_;
 537     # Create new status graph with:
 538     # - all core_status_graph
 539     # - for-each each backend_status_graph
 540     #   + add to new status graph
 541     #   + for each core prev_action:
 542     #     * locate core_status
 543     #     * update next_actions with additional next action.
 544     #   + for each core next_action:
 545     #     * locate core_status
 546     #     * update prev_actions with additional prev action
 547
 548     my @core_status_ids = keys %{$core_status_graph};
 549     my $status_graph = clone($core_status_graph);
 550
 551     foreach my $backend_status_key ( keys %{$backend_status_graph} ) {
 552         my $backend_status = $backend_status_graph->{$backend_status_key};
 553         # Add to new status graph
 554         $status_graph->{$backend_status_key} = $backend_status;
 555         # Update all core methods' next_actions.
 556         foreach my $prev_action ( @{$backend_status->{prev_actions}} ) {
 557             if ( grep { $prev_action eq $_ } @core_status_ids ) {
 558                 my @next_actions =
 559                      @{$status_graph->{$prev_action}->{next_actions}};
 560                 push @next_actions, $backend_status_key;
 561                 $status_graph->{$prev_action}->{next_actions}
 562                     = \@next_actions;
 563             }
 564         }
 565         # Update all core methods' prev_actions
 566         foreach my $next_action ( @{$backend_status->{next_actions}} ) {
 567             if ( grep { $next_action eq $_ } @core_status_ids ) {
 568                 my @prev_actions =
 569                      @{$status_graph->{$next_action}->{prev_actions}};
 570                 push @prev_actions, $backend_status_key;
 571                 $status_graph->{$next_action}->{prev_actions}
 572                     = \@prev_actions;
 573             }
 574         }
 575     }
 576
 577     return $status_graph;
 578 }
 579
 580 ### Core API methods
 581
 582 =head3 capabilities
 583
 584     my $capabilities = $illrequest->capabilities;
 585
 586 Return a hashref mapping methods to operation names supported by the queried
 587 backend.
 588
 589 Example return value:
 590
 591     { create => "Create Request", confirm => "Progress Request" }
 592
 593 NOTE: this module suffers from a confusion in termninology:
 594
 595 in _backend_capability, the notion of capability refers to an optional feature
 596 that is implemented in core, but might not be supported by a given backend.
 597
 598 in capabilities & custom_capability, capability refers to entries in the
 599 status_graph (after union between backend and core).
 600
 601 The easiest way to fix this would be to fix the terminology in
 602 capabilities & custom_capability and their callers.
 603
 604 =cut
 605
 606 sub capabilities {
 607     my ( $self, $status ) = @_;
 608     # Generate up to date status_graph
 609     my $status_graph = $self->_status_graph_union(
 610         $self->_core_status_graph,
 611         $self->_backend->status_graph({
 612             request => $self,
 613             other   => {}
 614         })
 615     );
 616     # Extract available actions from graph.
 617     return $status_graph->{$status} if $status;
 618     # Or return entire graph.
 619     return $status_graph;
 620 }
 621
 622 =head3 custom_capability
 623
 624 Return the result of invoking $CANDIDATE on this request's backend with
 625 $PARAMS, or 0 if $CANDIDATE is an unknown method on backend.
 626
 627 NOTE: this module suffers from a confusion in termninology:
 628
 629 in _backend_capability, the notion of capability refers to an optional feature
 630 that is implemented in core, but might not be supported by a given backend.
 631
 632 in capabilities & custom_capability, capability refers to entries in the
 633 status_graph (after union between backend and core).
 634
 635 The easiest way to fix this would be to fix the terminology in
 636 capabilities & custom_capability and their callers.
 637
 638 =cut
 639
 640 sub custom_capability {
 641     my ( $self, $candidate, $params ) = @_;
 642     foreach my $capability ( values %{$self->capabilities} ) {
 643         if ( $candidate eq $capability->{method} ) {
 644             my $response =
 645                 $self->_backend->$candidate({
 646                     request    => $self,
 647                     other      => $params,
 648                 });
 649             return $self->expandTemplate($response);
 650         }
 651     }
 652     return 0;
 653 }
 654
 655 =head3 available_backends
 656
 657 Return a list of available backends.
 658
 659 =cut
 660
 661 sub available_backends {
 662     my ( $self, $reduced ) = @_;
 663     my $backends = $self->_config->available_backends($reduced);
 664     return $backends;
 665 }
 666
 667 =head3 available_actions
 668
 669 Return a list of available actions.
 670
 671 =cut
 672
 673 sub available_actions {
 674     my ( $self ) = @_;
 675     my $current_action = $self->capabilities($self->status);
 676     my @available_actions = map { $self->capabilities($_) }
 677         @{$current_action->{next_actions}};
 678     return \@available_actions;
 679 }
 680
 681 =head3 mark_completed
 682
 683 Mark a request as completed (status = COMP).
 684
 685 =cut
 686
 687 sub mark_completed {
 688     my ( $self ) = @_;
 689     $self->status('COMP')->store;
 690     $self->completed(DateTime->now)->store;
 691     return {
 692         error   => 0,
 693         status  => '',
 694         message => '',
 695         method  => 'mark_completed',
 696         stage   => 'commit',
 697         next    => 'illview',
 698     };
 699 }
 700
 701 =head2 backend_migrate
 702
 703 Migrate a request from one backend to another.
 704
 705 =cut
 706
 707 sub backend_migrate {
 708     my ( $self, $params ) = @_;
 709
 710     my $response = $self->_backend_capability('migrate',{
 711             request    => $self,
 712             other      => $params,
 713         });
 714     return $self->expandTemplate($response) if $response;
 715     return $response;
 716 }
 717
 718 =head2 backend_confirm
 719
 720 Confirm a request. The backend handles setting of mandatory fields in the commit stage:
 721
 722 =over
 723
 724 =item * orderid
 725
 726 =item * accessurl, cost (if available).
 727
 728 =back
 729
 730 =cut
 731
 732 sub backend_confirm {
 733     my ( $self, $params ) = @_;
 734
 735     my $response = $self->_backend->confirm({
 736             request    => $self,
 737             other      => $params,
 738         });
 739     return $self->expandTemplate($response);
 740 }
 741
 742 =head3 backend_update_status
 743
 744 =cut
 745
 746 sub backend_update_status {
 747     my ( $self, $params ) = @_;
 748     return $self->expandTemplate($self->_backend->update_status($params));
 749 }
 750
 751 =head3 backend_cancel
 752
 753     my $ILLResponse = $illRequest->backend_cancel;
 754
 755 The standard interface method allowing for request cancellation.
 756
 757 =cut
 758
 759 sub backend_cancel {
 760     my ( $self, $params ) = @_;
 761
 762     my $result = $self->_backend->cancel({
 763         request => $self,
 764         other => $params
 765     });
 766
 767     return $self->expandTemplate($result);
 768 }
 769
 770 =head3 backend_renew
 771
 772     my $renew_response = $illRequest->backend_renew;
 773
 774 The standard interface method allowing for request renewal queries.
 775
 776 =cut
 777
 778 sub backend_renew {
 779     my ( $self ) = @_;
 780     return $self->expandTemplate(
 781         $self->_backend->renew({
 782             request    => $self,
 783         })
 784     );
 785 }
 786
 787 =head3 backend_create
 788
 789     my $create_response = $abstractILL->backend_create($params);
 790
 791 Return an array of Record objects created by querying our backend with
 792 a Search query.
 793
 794 In the context of the other ILL methods, this is a special method: we only
 795 pass it $params, as it does not yet have any other data associated with it.
 796
 797 =cut
 798
 799 sub backend_create {
 800     my ( $self, $params ) = @_;
 801
 802     # Establish whether we need to do a generic copyright clearance.
 803     if ($params->{opac}) {
 804         if ( ( !$params->{stage} || $params->{stage} eq 'init' )
 805                 && C4::Context->preference("ILLModuleCopyrightClearance") ) {
 806             return {
 807                 error   => 0,
 808                 status  => '',
 809                 message => '',
 810                 method  => 'create',
 811                 stage   => 'copyrightclearance',
 812                 value   => {
 813                     other   => $params,
 814                     backend => $self->_backend->name
 815                 }
 816             };
 817         } elsif (     defined $params->{stage}
 818                 && $params->{stage} eq 'copyrightclearance' ) {
 819             $params->{stage} = 'init';
 820         }
 821     }
 822     # First perform API action, then...
 823     my $args = {
 824         request => $self,
 825         other   => $params,
 826     };
 827     my $result = $self->_backend->create($args);
 828
 829     # ... simple case: we're not at 'commit' stage.
 830     my $stage = $result->{stage};
 831     return $self->expandTemplate($result)
 832         unless ( 'commit' eq $stage );
 833
 834     # ... complex case: commit!
 835
 836     # Do we still have space for an ILL or should we queue?
 837     my $permitted = $self->check_limits(
 838         { patron => $self->patron }, { librarycode => $self->branchcode }
 839     );
 840
 841     # Now augment our committed request.
 842
 843     $result->{permitted} = $permitted;             # Queue request?
 844
 845     # This involves...
 846
 847     # ...Updating status!
 848     $self->status('QUEUED')->store unless ( $permitted );
 849
 850     ## Handle Unmediated ILLs
 851
 852     # For the unmediated workflow we only need to delegate to our backend. If
 853     # that backend supports unmediateld_ill, it will do its thing and return a
 854     # proper response.  If it doesn't then _backend_capability returns 0, so
 855     # we keep the current result.
 856     if ( C4::Context->preference("ILLModuleUnmediated") && $permitted ) {
 857         my $unmediated_result = $self->_backend_capability(
 858             'unmediated_ill',
 859             $args
 860         );
 861         $result = $unmediated_result if $unmediated_result;
 862     }
 863
 864     return $self->expandTemplate($result);
 865 }
 866
 867 =head3 expandTemplate
 868
 869     my $params = $abstract->expandTemplate($params);
 870
 871 Return a version of $PARAMS augmented with our required template path.
 872
 873 =cut
 874
 875 sub expandTemplate {
 876     my ( $self, $params ) = @_;
 877     my $backend = $self->_backend->name;
 878     # Generate path to file to load
 879     my $backend_dir = $self->_config->backend_dir;
 880     my $backend_tmpl = join "/", $backend_dir, $backend;
 881     my $intra_tmpl =  join "/", $backend_tmpl, "intra-includes",
 882         ( $params->{method}//q{} ) . ".inc";
 883     my $opac_tmpl =  join "/", $backend_tmpl, "opac-includes",
 884         ( $params->{method}//q{} ) . ".inc";
 885     # Set files to load
 886     $params->{template} = $intra_tmpl;
 887     $params->{opac_template} = $opac_tmpl;
 888     return $params;
 889 }
 890
 891 #### Abstract Imports
 892
 893 =head3 getLimits
 894
 895     my $limit_rules = $abstract->getLimits( {
 896         type  => 'brw_cat' | 'branch',
 897         value => $value
 898     } );
 899
 900 Return the ILL limit rules for the supplied combination of type / value.
 901
 902 As the config may have no rules for this particular type / value combination,
 903 or for the default, we must define fall-back values here.
 904
 905 =cut
 906
 907 sub getLimits {
 908     my ( $self, $params ) = @_;
 909     my $limits = $self->_config->getLimitRules($params->{type});
 910
 911     if (     defined $params->{value}
 912           && defined $limits->{$params->{value}} ) {
 913             return $limits->{$params->{value}};
 914     }
 915     else {
 916         return $limits->{default} || { count => -1, method => 'active' };
 917     }
 918 }
 919
 920 =head3 getPrefix
 921
 922     my $prefix = $abstract->getPrefix( {
 923         branch  => $branch_code
 924     } );
 925
 926 Return the ILL prefix as defined by our $params: either per borrower category,
 927 per branch or the default.
 928
 929 =cut
 930
 931 sub getPrefix {
 932     my ( $self, $params ) = @_;
 933     my $brn_prefixes = $self->_config->getPrefixes();
 934     return $brn_prefixes->{$params->{branch}} || ""; # "the empty prefix"
 935 }
 936
 937 =head3 get_type
 938
 939     my $type = $abstract->get_type();
 940
 941 Return a string representing the material type of this request or undef
 942
 943 =cut
 944
 945 sub get_type {
 946     my ($self) = @_;
 947     my $attr = $self->illrequestattributes->find({ type => 'type'});
 948     return if !$attr;
 949     return $attr->value;
 950 };
 951
 952 #### Illrequests Imports
 953
 954 =head3 check_limits
 955
 956     my $ok = $illRequests->check_limits( {
 957         borrower   => $borrower,
 958         branchcode => 'branchcode' | undef,
 959     } );
 960
 961 Given $PARAMS, a hashref containing a $borrower object and a $branchcode,
 962 see whether we are still able to place ILLs.
 963
 964 LimitRules are derived from koha-conf.xml:
 965  + default limit counts, and counting method
 966  + branch specific limit counts & counting method
 967  + borrower category specific limit counts & counting method
 968  + err on the side of caution: a counting fail will cause fail, even if
 969    the other counts passes.
 970
 971 =cut
 972
 973 sub check_limits {
 974     my ( $self, $params ) = @_;
 975     my $patron     = $params->{patron};
 976     my $branchcode = $params->{librarycode} || $patron->branchcode;
 977
 978     # Establish maximum number of allowed requests
 979     my ( $branch_rules, $brw_rules ) = (
 980         $self->getLimits( {
 981             type => 'branch',
 982             value => $branchcode
 983         } ),
 984         $self->getLimits( {
 985             type => 'brw_cat',
 986             value => $patron->categorycode,
 987         } ),
 988     );
 989     my ( $branch_limit, $brw_limit )
 990         = ( $branch_rules->{count}, $brw_rules->{count} );
 991     # Establish currently existing requests
 992     my ( $branch_count, $brw_count ) = (
 993         $self->_limit_counter(
 994             $branch_rules->{method}, { branchcode => $branchcode }
 995         ),
 996         $self->_limit_counter(
 997             $brw_rules->{method}, { borrowernumber => $patron->borrowernumber }
 998         ),
 999     );
1000
1001     # Compare and return
1002     # A limit of -1 means no limit exists.
1003     # We return blocked if either branch limit or brw limit is reached.
1004     if ( ( $branch_limit != -1 && $branch_limit <= $branch_count )
1005              || ( $brw_limit != -1 && $brw_limit <= $brw_count ) ) {
1006         return 0;
1007     } else {
1008         return 1;
1009     }
1010 }
1011
1012 sub _limit_counter {
1013     my ( $self, $method, $target ) = @_;
1014
1015     # Establish parameters of counts
1016     my $resultset;
1017     if ($method && $method eq 'annual') {
1018         $resultset = Koha::Illrequests->search({
1019             -and => [
1020                 %{$target},
1021                 \"YEAR(placed) = YEAR(NOW())"
1022             ]
1023         });
1024     } else {                    # assume 'active'
1025         # XXX: This status list is ugly. There should be a method in config
1026         # to return these.
1027         my $where = { status => { -not_in => [ 'QUEUED', 'COMP' ] } };
1028         $resultset = Koha::Illrequests->search({ %{$target}, %{$where} });
1029     }
1030
1031     # Fetch counts
1032     return $resultset->count;
1033 }
1034
1035 =head3 requires_moderation
1036
1037     my $status = $illRequest->requires_moderation;
1038
1039 Return the name of the status if moderation by staff is required; or 0
1040 otherwise.
1041
1042 =cut
1043
1044 sub requires_moderation {
1045     my ( $self ) = @_;
1046     my $require_moderation = {
1047         'CANCREQ' => 'CANCREQ',
1048     };
1049     return $require_moderation->{$self->status};
1050 }
1051
1052 =head3 check_out
1053
1054     my $stage_summary = $request->check_out;
1055
1056 Handle the check_out method. The first stage involves gathering the required
1057 data from the user via a form, the second stage creates an item and tries to
1058 issue it to the patron. If successful, it notifies the patron, then it
1059 returns a summary of how things went
1060
1061 =cut
1062
1063 sub check_out {
1064     my ( $self, $params ) = @_;
1065
1066     # Objects required by the template
1067     my $itemtypes = Koha::ItemTypes->search(
1068         {},
1069         { order_by => ['description'] }
1070     );
1071     my $libraries = Koha::Libraries->search(
1072         {},
1073         { order_by => ['branchcode'] }
1074     );
1075     my $biblio = Koha::Biblios->find({
1076         biblionumber => $self->biblio_id
1077     });
1078     # Find all statistical patrons
1079     my $statistical_patrons = Koha::Patrons->search(
1080         { 'category_type' => 'x' },
1081         { join => { 'categorycode' => 'borrowers' } }
1082     );
1083
1084     if (!$params->{stage} || $params->{stage} eq 'init') {
1085         # Present a form to gather the required data
1086         #
1087         # We may be viewing this page having previously tried to issue
1088         # the item (in which case, we may already have created an item)
1089         # so we pass the biblio for this request
1090         return {
1091             method  => 'check_out',
1092             stage   => 'form',
1093             value   => {
1094                 itemtypes   => $itemtypes,
1095                 libraries   => $libraries,
1096                 statistical => $statistical_patrons,
1097                 biblio      => $biblio
1098             }
1099         };
1100     } elsif ($params->{stage} eq 'form') {
1101         # Validate what we've got and return with an error if we fail
1102         my $errors = {};
1103         if (!$params->{item_type} || length $params->{item_type} == 0) {
1104             $errors->{item_type} = 1;
1105         }
1106         if ($params->{inhouse} && length $params->{inhouse} > 0) {
1107             my $patron_count = Koha::Patrons->search({
1108                 cardnumber => $params->{inhouse}
1109             })->count();
1110             if ($patron_count != 1) {
1111                 $errors->{inhouse} = 1;
1112             }
1113         }
1114
1115         # Check we don't have more than one item for this bib,
1116         # if we do, something very odd is going on
1117         # Having 1 is OK, it means we're likely trying to issue
1118         # following a previously failed attempt, the item exists
1119         # so we'll use it
1120         my @items = $biblio->items->as_list;
1121         my $item_count = scalar @items;
1122         if ($item_count > 1) {
1123             $errors->{itemcount} = 1;
1124         }
1125
1126         # Failed validation, go back to the form
1127         if (%{$errors}) {
1128             return {
1129                 method  => 'check_out',
1130                 stage   => 'form',
1131                 value   => {
1132                     params      => $params,
1133                     statistical => $statistical_patrons,
1134                     itemtypes   => $itemtypes,
1135                     libraries   => $libraries,
1136                     biblio      => $biblio,
1137                     errors      => $errors
1138                 }
1139             };
1140         }
1141
1142         # Passed validation
1143         #
1144         # Create an item if one doesn't already exist,
1145         # if one does, use that
1146         my $itemnumber;
1147         if ($item_count == 0) {
1148             my $item_hash = {
1149                 homebranch    => $params->{branchcode},
1150                 holdingbranch => $params->{branchcode},
1151                 location      => $params->{branchcode},
1152                 itype         => $params->{item_type},
1153                 barcode       => 'ILL-' . $self->illrequest_id
1154             };
1155             my (undef, undef, $item_no) =
1156                 AddItem($item_hash, $self->biblio_id);
1157             $itemnumber = $item_no;
1158         } else {
1159             $itemnumber = $items[0]->itemnumber;
1160         }
1161         # Check we have an item before going forward
1162         if (!$itemnumber) {
1163             return {
1164                 method  => 'check_out',
1165                 stage   => 'form',
1166                 value   => {
1167                     params      => $params,
1168                     itemtypes   => $itemtypes,
1169                     libraries   => $libraries,
1170                     statistical => $statistical_patrons,
1171                     errors      => { item_creation => 1 }
1172                 }
1173             };
1174         }
1175
1176         # Do the check out
1177         #
1178         # Gather what we need
1179         my $target_item = Koha::Items->find( $itemnumber );
1180         # Determine who we're issuing to
1181         my $patron = $params->{inhouse} && length $params->{inhouse} > 0 ?
1182             Koha::Patrons->find({ cardnumber => $params->{inhouse} }) :
1183             $self->patron;
1184
1185         my @issue_args = (
1186             $patron,
1187             scalar $target_item->barcode
1188         );
1189         if ($params->{duedate} && length $params->{duedate} > 0) {
1190             push @issue_args, $params->{duedate};
1191         }
1192         # Check if we can check out
1193         my ( $error, $confirm, $alerts, $messages ) =
1194             C4::Circulation::CanBookBeIssued(@issue_args);
1195
1196         # If we got anything back saying we can't check out,
1197         # return it to the template
1198         my $problems = {};
1199         if ( $error && %{$error} ) { $problems->{error} = $error };
1200         if ( $confirm && %{$confirm} ) { $problems->{confirm} = $confirm };
1201         if ( $alerts && %{$alerts} ) { $problems->{alerts} = $alerts };
1202         if ( $messages && %{$messages} ) { $problems->{messages} = $messages };
1203
1204         if (%{$problems}) {
1205             return {
1206                 method  => 'check_out',
1207                 stage   => 'form',
1208                 value   => {
1209                     params           => $params,
1210                     itemtypes        => $itemtypes,
1211                     libraries        => $libraries,
1212                     statistical      => $statistical_patrons,
1213                     patron           => $patron,
1214                     biblio           => $biblio,
1215                     check_out_errors => $problems
1216                 }
1217             };
1218         }
1219
1220         # We can allegedly check out, so make it so
1221         # For some reason, AddIssue requires an unblessed Patron
1222         $issue_args[0] = $patron->unblessed;
1223         my $issue = C4::Circulation::AddIssue(@issue_args);
1224
1225         if ($issue) {
1226             # Update the request status
1227             $self->status('CHK')->store;
1228             return {
1229                 method  => 'check_out',
1230                 stage   => 'done_check_out',
1231                 value   => {
1232                     params    => $params,
1233                     patron    => $patron,
1234                     check_out => $issue
1235                 }
1236             };
1237         } else {
1238             return {
1239                 method  => 'check_out',
1240                 stage   => 'form',
1241                 value   => {
1242                     params    => $params,
1243                     itemtypes => $itemtypes,
1244                     libraries => $libraries,
1245                     errors    => { item_check_out => 1 }
1246                 }
1247             };
1248         }
1249     }
1250
1251 }
1252
1253 =head3 generic_confirm
1254
1255     my $stage_summary = $illRequest->generic_confirm;
1256
1257 Handle the generic_confirm extended method.  The first stage involves creating
1258 a template email for the end user to edit in the browser.  The second stage
1259 attempts to submit the email.
1260
1261 =cut
1262
1263 sub generic_confirm {
1264     my ( $self, $params ) = @_;
1265     my $branch = Koha::Libraries->find($params->{current_branchcode})
1266         || die "Invalid current branchcode. Are you logged in as the database user?";
1267     if ( !$params->{stage}|| $params->{stage} eq 'init' ) {
1268         my $draft->{subject} = "ILL Request";
1269         $draft->{body} = <<EOF;
1270 Dear Sir/Madam,
1271
1272     We would like to request an interlibrary loan for a title matching the
1273 following description:
1274
1275 EOF
1276
1277         my $details = $self->metadata;
1278         while (my ($title, $value) = each %{$details}) {
1279             $draft->{body} .= "  - " . $title . ": " . $value . "\n"
1280                 if $value;
1281         }
1282         $draft->{body} .= <<EOF;
1283
1284 Please let us know if you are able to supply this to us.
1285
1286 Kind Regards
1287
1288 EOF
1289
1290         my @address = map { $branch->$_ }
1291             qw/ branchname branchaddress1 branchaddress2 branchaddress3
1292                 branchzip branchcity branchstate branchcountry branchphone
1293                 branchemail /;
1294         my $address = "";
1295         foreach my $line ( @address ) {
1296             $address .= $line . "\n" if $line;
1297         }
1298
1299         $draft->{body} .= $address;
1300
1301         my $partners = Koha::Patrons->search({
1302             categorycode => $self->_config->partner_code
1303         });
1304         return {
1305             error   => 0,
1306             status  => '',
1307             message => '',
1308             method  => 'generic_confirm',
1309             stage   => 'draft',
1310             value   => {
1311                 draft    => $draft,
1312                 partners => $partners,
1313             }
1314         };
1315
1316     } elsif ( 'draft' eq $params->{stage} ) {
1317         # Create the to header
1318         my $to = $params->{partners};
1319         if ( defined $to ) {
1320             $to =~ s/^\x00//;       # Strip leading NULLs
1321             $to =~ s/\x00/; /;      # Replace others with '; '
1322         }
1323         Koha::Exceptions::Ill::NoTargetEmail->throw(
1324             "No target email addresses found. Either select at least one partner or check your ILL partner library records.")
1325           if ( !$to );
1326         # Create the from, replyto and sender headers
1327         my $from = $branch->branchemail;
1328         my $replyto = $branch->branchreplyto || $from;
1329         Koha::Exceptions::Ill::NoLibraryEmail->throw(
1330             "Your library has no usable email address. Please set it.")
1331           if ( !$from );
1332
1333         # Create the email
1334         my $message = Koha::Email->new;
1335         my %mail = $message->create_message_headers(
1336             {
1337                 to          => $to,
1338                 from        => $from,
1339                 replyto     => $replyto,
1340                 subject     => Encode::encode( "utf8", $params->{subject} ),
1341                 message     => Encode::encode( "utf8", $params->{body} ),
1342                 contenttype => 'text/plain',
1343             }
1344         );
1345         # Send it
1346         my $result = sendmail(%mail);
1347         if ( $result ) {
1348             $self->status("GENREQ")->store;
1349             $self->_backend_capability(
1350                 'set_requested_partners',
1351                 {
1352                     request => $self,
1353                     to => $to
1354                 }
1355             );
1356             return {
1357                 error   => 0,
1358                 status  => '',
1359                 message => '',
1360                 method  => 'generic_confirm',
1361                 stage   => 'commit',
1362                 next    => 'illview',
1363             };
1364         } else {
1365             return {
1366                 error   => 1,
1367                 status  => 'email_failed',
1368                 message => $Mail::Sendmail::error,
1369                 method  => 'generic_confirm',
1370                 stage   => 'draft',
1371             };
1372         }
1373     } else {
1374         die "Unknown stage, should not have happened."
1375     }
1376 }
1377
1378 =head3 id_prefix
1379
1380     my $prefix = $record->id_prefix;
1381
1382 Return the prefix appropriate for the current Illrequest as derived from the
1383 borrower and branch associated with this request's Status, and the config
1384 file.
1385
1386 =cut
1387
1388 sub id_prefix {
1389     my ( $self ) = @_;
1390     my $prefix = $self->getPrefix( {
1391         branch  => $self->branchcode,
1392     } );
1393     $prefix .= "-" if ( $prefix );
1394     return $prefix;
1395 }
1396
1397 =head3 _censor
1398
1399     my $params = $illRequest->_censor($params);
1400
1401 Return $params, modified to reflect our censorship requirements.
1402
1403 =cut
1404
1405 sub _censor {
1406     my ( $self, $params ) = @_;
1407     my $censorship = $self->_config->censorship;
1408     $params->{censor_notes_staff} = $censorship->{censor_notes_staff}
1409         if ( $params->{opac} );
1410     $params->{display_reply_date} = ( $censorship->{censor_reply_date} ) ? 0 : 1;
1411
1412     return $params;
1413 }
1414
1415 =head3 store
1416
1417     $Illrequest->store;
1418
1419 Overloaded I<store> method that, in addition to performing the 'store',
1420 possibly records the fact that something happened
1421
1422 =cut
1423
1424 sub store {
1425     my ( $self, $attrs ) = @_;
1426
1427     my $ret = $self->SUPER::store;
1428
1429     $attrs->{log_origin} = 'core';
1430
1431     if ($ret && defined $attrs) {
1432         my $logger = Koha::Illrequest::Logger->new;
1433         $logger->log_maybe({
1434             request => $self,
1435             attrs   => $attrs
1436         });
1437     }
1438
1439     return $ret;
1440 }
1441
1442 =head3 requested_partners
1443
1444     my $partners_string = $illRequest->requested_partners;
1445
1446 Return the string representing the email addresses of the partners to
1447 whom a request has been sent
1448
1449 =cut
1450
1451 sub requested_partners {
1452     my ( $self ) = @_;
1453     return $self->_backend_capability(
1454         'get_requested_partners',
1455         { request => $self }
1456     );
1457 }
1458
1459 =head3 TO_JSON
1460
1461     $json = $illrequest->TO_JSON
1462
1463 Overloaded I<TO_JSON> method that takes care of inserting calculated values
1464 into the unblessed representation of the object.
1465
1466 TODO: This method does nothing and is not called anywhere. However, bug 74325
1467 touches it, so keeping this for now until both this and bug 74325 are merged,
1468 at which point we can sort it out and remove it completely
1469
1470 =cut
1471
1472 sub TO_JSON {
1473     my ( $self, $embed ) = @_;
1474
1475     my $object = $self->SUPER::TO_JSON();
1476
1477     return $object;
1478 }
1479
1480 =head2 Internal methods
1481
1482 =head3 _type
1483
1484 =cut
1485
1486 sub _type {
1487     return 'Illrequest';
1488 }
1489
1490 =head1 AUTHOR
1491
1492 Alex Sassmannshausen <alex.sassmannshausen@ptfs-europe.com>
1493 Andrew Isherwood <andrew.isherwood@ptfs-europe.com>
1494
1495 =cut
1496
1497 1;