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