Koha/Illrequest.pm

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