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