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