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