Bug 18235: (QA follow-up) Add missing filters
[koha.git] / Koha / Illrequest.pm
blob57e47260dd530e21023abc1f425b19a98a1d539d
1 package Koha::Illrequest;
3 # Copyright PTFS Europe 2016,2018
5 # This file is part of Koha.
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.
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.
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.
21 use Modern::Perl;
23 use Clone 'clone';
24 use File::Basename qw( basename );
25 use Encode qw( encode );
26 use Mail::Sendmail;
27 use Try::Tiny;
28 use DateTime;
30 use Koha::Database;
31 use Koha::Email;
32 use Koha::Exceptions::Ill;
33 use Koha::Illcomments;
34 use Koha::Illrequestattributes;
35 use Koha::AuthorisedValue;
36 use Koha::Illrequest::Logger;
37 use Koha::Patron;
38 use Koha::AuthorisedValues;
40 use base qw(Koha::Object);
42 =head1 NAME
44 Koha::Illrequest - Koha Illrequest Object class
46 =head1 (Re)Design
48 An ILLRequest consists of two parts; the Illrequest Koha::Object, and a series
49 of related Illrequestattributes.
51 The former encapsulates the basic necessary information that any ILL requires
52 to be usable in Koha. The latter is a set of additional properties used by
53 one of the backends.
55 The former subsumes the legacy "Status" object. The latter remains
56 encapsulated in the "Record" object.
58 TODO:
60 - Anything invoking the ->status method; annotated with:
61 + # Old use of ->status !
63 =head1 API
65 =head2 Backend API Response Principles
67 All methods should return a hashref in the following format:
69 =over
71 =item * error
73 This should be set to 1 if an error was encountered.
75 =item * status
77 The status should be a string from the list of statuses detailed below.
79 =item * message
81 The message is a free text field that can be passed on to the end user.
83 =item * value
85 The value returned by the method.
87 =back
89 =head2 Interface Status Messages
91 =over
93 =item * branch_address_incomplete
95 An interface request has determined branch address details are incomplete.
97 =item * cancel_success
99 The interface's cancel_request method was successful in cancelling the
100 Illrequest using the API.
102 =item * cancel_fail
104 The interface's cancel_request method failed to cancel the Illrequest using
105 the API.
107 =item * unavailable
109 The interface's request method returned saying that the desired item is not
110 available for request.
112 =back
114 =head2 Class methods
116 =head3 statusalias
118 my $statusalias = $request->statusalias;
120 Returns a request's status alias, as a Koha::AuthorisedValue instance
121 or implicit undef. This is distinct from status_alias, which only returns
122 the value in the status_alias column, this method returns the entire
123 AuthorisedValue object
125 =cut
127 sub statusalias {
128 my ( $self ) = @_;
129 return unless $self->status_alias;
130 # We can't know which result is the right one if there are multiple
131 # ILLSTATUS authorised values with the same authorised_value column value
132 # so we just use the first
133 return Koha::AuthorisedValues->search({
134 branchcode => $self->branchcode,
135 category => 'ILLSTATUS',
136 authorised_value => $self->SUPER::status_alias
137 })->next;
140 =head3 illrequestattributes
142 =cut
144 sub illrequestattributes {
145 my ( $self ) = @_;
146 return Koha::Illrequestattributes->_new_from_dbic(
147 scalar $self->_result->illrequestattributes
151 =head3 illcomments
153 =cut
155 sub illcomments {
156 my ( $self ) = @_;
157 return Koha::Illcomments->_new_from_dbic(
158 scalar $self->_result->illcomments
162 =head3 logs
164 =cut
166 sub logs {
167 my ( $self ) = @_;
168 my $logger = Koha::Illrequest::Logger->new;
169 return $logger->get_request_logs($self);
172 =head3 patron
174 =cut
176 sub patron {
177 my ( $self ) = @_;
178 return Koha::Patron->_new_from_dbic(
179 scalar $self->_result->borrowernumber
183 =head3 status_alias
185 $Illrequest->status_alias(143);
187 Overloaded getter/setter for status_alias,
188 that only returns authorised values from the
189 correct category and records the fact that the status has changed
191 =cut
193 sub status_alias {
194 my ($self, $new_status_alias) = @_;
196 my $current_status_alias = $self->SUPER::status_alias;
198 if ($new_status_alias) {
199 # Keep a record of the previous status before we change it,
200 # we might need it
201 $self->{previous_status} = $current_status_alias ?
202 $current_status_alias :
203 scalar $self->status;
204 # This is hackery to enable us to undefine
205 # status_alias, since we need to have an overloaded
206 # status_alias method to get us around the problem described
207 # here:
208 # https://bugs.koha-community.org/bugzilla3/show_bug.cgi?id=20581#c156
209 # We need a way of accepting implied undef, so we can nullify
210 # the status_alias column, when called from $self->status
211 my $val = $new_status_alias eq "-1" ? undef : $new_status_alias;
212 my $ret = $self->SUPER::status_alias($val);
213 my $val_to_log = $val ? $new_status_alias : scalar $self->status;
214 if ($ret) {
215 my $logger = Koha::Illrequest::Logger->new;
216 $logger->log_status_change({
217 request => $self,
218 value => $val_to_log
220 } else {
221 delete $self->{previous_status};
223 return $ret;
225 # We can't know which result is the right one if there are multiple
226 # ILLSTATUS authorised values with the same authorised_value column value
227 # so we just use the first
228 my $alias = Koha::AuthorisedValues->search({
229 branchcode => $self->branchcode,
230 category => 'ILLSTATUS',
231 authorised_value => $self->SUPER::status_alias
232 })->next;
233 if ($alias) {
234 return $alias->authorised_value;
235 } else {
236 return;
240 =head3 status
242 $Illrequest->status('CANREQ');
244 Overloaded getter/setter for request status,
245 also nullifies status_alias and records the fact that the status has changed
247 =cut
249 sub status {
250 my ( $self, $new_status) = @_;
252 my $current_status = $self->SUPER::status;
253 my $current_status_alias = $self->SUPER::status_alias;
255 if ($new_status) {
256 # Keep a record of the previous status before we change it,
257 # we might need it
258 $self->{previous_status} = $current_status_alias ?
259 $current_status_alias :
260 $current_status;
261 my $ret = $self->SUPER::status($new_status)->store;
262 if ($current_status_alias) {
263 # This is hackery to enable us to undefine
264 # status_alias, since we need to have an overloaded
265 # status_alias method to get us around the problem described
266 # here:
267 # https://bugs.koha-community.org/bugzilla3/show_bug.cgi?id=20581#c156
268 # We need a way of passing implied undef to nullify status_alias
269 # so we pass -1, which is special cased in the overloaded setter
270 $self->status_alias("-1");
271 } else {
272 my $logger = Koha::Illrequest::Logger->new;
273 $logger->log_status_change({
274 request => $self,
275 value => $new_status
278 delete $self->{previous_status};
279 return $ret;
280 } else {
281 return $current_status;
285 =head3 load_backend
287 Require "Base.pm" from the relevant ILL backend.
289 =cut
291 sub load_backend {
292 my ( $self, $backend_id ) = @_;
294 my @raw = qw/Koha Illbackends/; # Base Path
296 my $backend_name = $backend_id || $self->backend;
298 unless ( defined $backend_name && $backend_name ne '' ) {
299 Koha::Exceptions::Ill::InvalidBackendId->throw(
300 "An invalid backend ID was requested ('')");
303 my $location = join "/", @raw, $backend_name, "Base.pm"; # File to load
304 my $backend_class = join "::", @raw, $backend_name, "Base"; # Package name
305 require $location;
306 $self->{_my_backend} = $backend_class->new({
307 config => $self->_config,
308 logger => Koha::Illrequest::Logger->new
310 return $self;
314 =head3 _backend
316 my $backend = $abstract->_backend($new_backend);
317 my $backend = $abstract->_backend;
319 Getter/Setter for our API object.
321 =cut
323 sub _backend {
324 my ( $self, $backend ) = @_;
325 $self->{_my_backend} = $backend if ( $backend );
326 # Dynamically load our backend object, as late as possible.
327 $self->load_backend unless ( $self->{_my_backend} );
328 return $self->{_my_backend};
331 =head3 _backend_capability
333 my $backend_capability_result = $self->_backend_capability($name, $args);
335 This is a helper method to invoke optional capabilities in the backend. If
336 the capability named by $name is not supported, return 0, else invoke it,
337 passing $args along with the invocation, and return its return value.
339 NOTE: this module suffers from a confusion in termninology:
341 in _backend_capability, the notion of capability refers to an optional feature
342 that is implemented in core, but might not be supported by a given backend.
344 in capabilities & custom_capability, capability refers to entries in the
345 status_graph (after union between backend and core).
347 The easiest way to fix this would be to fix the terminology in
348 capabilities & custom_capability and their callers.
350 =cut
352 sub _backend_capability {
353 my ( $self, $name, $args ) = @_;
354 my $capability = 0;
355 # See if capability is defined in backend
356 try {
357 $capability = $self->_backend->capabilities($name);
358 } catch {
359 return 0;
361 # Try to invoke it
362 if ( $capability && ref($capability) eq 'CODE' ) {
363 return &{$capability}($args);
364 } else {
365 return 0;
369 =head3 _config
371 my $config = $abstract->_config($config);
372 my $config = $abstract->_config;
374 Getter/Setter for our config object.
376 =cut
378 sub _config {
379 my ( $self, $config ) = @_;
380 $self->{_my_config} = $config if ( $config );
381 # Load our config object, as late as possible.
382 unless ( $self->{_my_config} ) {
383 $self->{_my_config} = Koha::Illrequest::Config->new;
385 return $self->{_my_config};
388 =head3 metadata
390 =cut
392 sub metadata {
393 my ( $self ) = @_;
394 return $self->_backend->metadata($self);
397 =head3 _core_status_graph
399 my $core_status_graph = $illrequest->_core_status_graph;
401 Returns ILL module's default status graph. A status graph defines the list of
402 available actions at any stage in the ILL workflow. This is for instance used
403 by the perl script & template to generate the correct buttons to display to
404 the end user at any given point.
406 =cut
408 sub _core_status_graph {
409 my ( $self ) = @_;
410 return {
411 NEW => {
412 prev_actions => [ ], # Actions containing buttons
413 # leading to this status
414 id => 'NEW', # ID of this status
415 name => 'New request', # UI name of this status
416 ui_method_name => 'New request', # UI name of method leading
417 # to this status
418 method => 'create', # method to this status
419 next_actions => [ 'REQ', 'GENREQ', 'KILL' ], # buttons to add to all
420 # requests with this status
421 ui_method_icon => 'fa-plus', # UI Style class
423 REQ => {
424 prev_actions => [ 'NEW', 'REQREV', 'QUEUED', 'CANCREQ' ],
425 id => 'REQ',
426 name => 'Requested',
427 ui_method_name => 'Confirm request',
428 method => 'confirm',
429 next_actions => [ 'REQREV', 'COMP' ],
430 ui_method_icon => 'fa-check',
432 GENREQ => {
433 prev_actions => [ 'NEW', 'REQREV' ],
434 id => 'GENREQ',
435 name => 'Requested from partners',
436 ui_method_name => 'Place request with partners',
437 method => 'generic_confirm',
438 next_actions => [ 'COMP' ],
439 ui_method_icon => 'fa-send-o',
441 REQREV => {
442 prev_actions => [ 'REQ' ],
443 id => 'REQREV',
444 name => 'Request reverted',
445 ui_method_name => 'Revert Request',
446 method => 'cancel',
447 next_actions => [ 'REQ', 'GENREQ', 'KILL' ],
448 ui_method_icon => 'fa-times',
450 QUEUED => {
451 prev_actions => [ ],
452 id => 'QUEUED',
453 name => 'Queued request',
454 ui_method_name => 0,
455 method => 0,
456 next_actions => [ 'REQ', 'KILL' ],
457 ui_method_icon => 0,
459 CANCREQ => {
460 prev_actions => [ 'NEW' ],
461 id => 'CANCREQ',
462 name => 'Cancellation requested',
463 ui_method_name => 0,
464 method => 0,
465 next_actions => [ 'KILL', 'REQ' ],
466 ui_method_icon => 0,
468 COMP => {
469 prev_actions => [ 'REQ' ],
470 id => 'COMP',
471 name => 'Completed',
472 ui_method_name => 'Mark completed',
473 method => 'mark_completed',
474 next_actions => [ ],
475 ui_method_icon => 'fa-check',
477 KILL => {
478 prev_actions => [ 'QUEUED', 'REQREV', 'NEW', 'CANCREQ' ],
479 id => 'KILL',
480 name => 0,
481 ui_method_name => 'Delete request',
482 method => 'delete',
483 next_actions => [ ],
484 ui_method_icon => 'fa-trash',
489 =head3 _core_status_graph
491 my $status_graph = $illrequest->_core_status_graph($origin, $new_graph);
493 Return a new status_graph, the result of merging $origin & new_graph. This is
494 operation is a union over the sets defied by the two graphs.
496 Each entry in $new_graph is added to $origin. We do not provide a syntax for
497 'subtraction' of entries from $origin.
499 Whilst it is not intended that this works, you can override entries in $origin
500 with entries with the same key in $new_graph. This can lead to problematic
501 behaviour when $new_graph adds an entry, which modifies a dependent entry in
502 $origin, only for the entry in $origin to be replaced later with a new entry
503 from $new_graph.
505 NOTE: this procedure does not "re-link" entries in $origin or $new_graph,
506 i.e. each of the graphs need to be correct at the outset of the operation.
508 =cut
510 sub _status_graph_union {
511 my ( $self, $core_status_graph, $backend_status_graph ) = @_;
512 # Create new status graph with:
513 # - all core_status_graph
514 # - for-each each backend_status_graph
515 # + add to new status graph
516 # + for each core prev_action:
517 # * locate core_status
518 # * update next_actions with additional next action.
519 # + for each core next_action:
520 # * locate core_status
521 # * update prev_actions with additional prev action
523 my @core_status_ids = keys %{$core_status_graph};
524 my $status_graph = clone($core_status_graph);
526 foreach my $backend_status_key ( keys %{$backend_status_graph} ) {
527 my $backend_status = $backend_status_graph->{$backend_status_key};
528 # Add to new status graph
529 $status_graph->{$backend_status_key} = $backend_status;
530 # Update all core methods' next_actions.
531 foreach my $prev_action ( @{$backend_status->{prev_actions}} ) {
532 if ( grep $prev_action, @core_status_ids ) {
533 my @next_actions =
534 @{$status_graph->{$prev_action}->{next_actions}};
535 push @next_actions, $backend_status_key;
536 $status_graph->{$prev_action}->{next_actions}
537 = \@next_actions;
540 # Update all core methods' prev_actions
541 foreach my $next_action ( @{$backend_status->{next_actions}} ) {
542 if ( grep $next_action, @core_status_ids ) {
543 my @prev_actions =
544 @{$status_graph->{$next_action}->{prev_actions}};
545 push @prev_actions, $backend_status_key;
546 $status_graph->{$next_action}->{prev_actions}
547 = \@prev_actions;
552 return $status_graph;
555 ### Core API methods
557 =head3 capabilities
559 my $capabilities = $illrequest->capabilities;
561 Return a hashref mapping methods to operation names supported by the queried
562 backend.
564 Example return value:
566 { create => "Create Request", confirm => "Progress Request" }
568 NOTE: this module suffers from a confusion in termninology:
570 in _backend_capability, the notion of capability refers to an optional feature
571 that is implemented in core, but might not be supported by a given backend.
573 in capabilities & custom_capability, capability refers to entries in the
574 status_graph (after union between backend and core).
576 The easiest way to fix this would be to fix the terminology in
577 capabilities & custom_capability and their callers.
579 =cut
581 sub capabilities {
582 my ( $self, $status ) = @_;
583 # Generate up to date status_graph
584 my $status_graph = $self->_status_graph_union(
585 $self->_core_status_graph,
586 $self->_backend->status_graph({
587 request => $self,
588 other => {}
591 # Extract available actions from graph.
592 return $status_graph->{$status} if $status;
593 # Or return entire graph.
594 return $status_graph;
597 =head3 custom_capability
599 Return the result of invoking $CANDIDATE on this request's backend with
600 $PARAMS, or 0 if $CANDIDATE is an unknown method on backend.
602 NOTE: this module suffers from a confusion in termninology:
604 in _backend_capability, the notion of capability refers to an optional feature
605 that is implemented in core, but might not be supported by a given backend.
607 in capabilities & custom_capability, capability refers to entries in the
608 status_graph (after union between backend and core).
610 The easiest way to fix this would be to fix the terminology in
611 capabilities & custom_capability and their callers.
613 =cut
615 sub custom_capability {
616 my ( $self, $candidate, $params ) = @_;
617 foreach my $capability ( values %{$self->capabilities} ) {
618 if ( $candidate eq $capability->{method} ) {
619 my $response =
620 $self->_backend->$candidate({
621 request => $self,
622 other => $params,
624 return $self->expandTemplate($response);
627 return 0;
630 =head3 available_backends
632 Return a list of available backends.
634 =cut
636 sub available_backends {
637 my ( $self, $reduced ) = @_;
638 my $backends = $self->_config->available_backends($reduced);
639 return $backends;
642 =head3 available_actions
644 Return a list of available actions.
646 =cut
648 sub available_actions {
649 my ( $self ) = @_;
650 my $current_action = $self->capabilities($self->status);
651 my @available_actions = map { $self->capabilities($_) }
652 @{$current_action->{next_actions}};
653 return \@available_actions;
656 =head3 mark_completed
658 Mark a request as completed (status = COMP).
660 =cut
662 sub mark_completed {
663 my ( $self ) = @_;
664 $self->status('COMP')->store;
665 $self->completed(DateTime->now)->store;
666 return {
667 error => 0,
668 status => '',
669 message => '',
670 method => 'mark_completed',
671 stage => 'commit',
672 next => 'illview',
676 =head2 backend_migrate
678 Migrate a request from one backend to another.
680 =cut
682 sub backend_migrate {
683 my ( $self, $params ) = @_;
685 my $response = $self->_backend_capability('migrate',{
686 request => $self,
687 other => $params,
689 return $self->expandTemplate($response) if $response;
690 return $response;
693 =head2 backend_confirm
695 Confirm a request. The backend handles setting of mandatory fields in the commit stage:
697 =over
699 =item * orderid
701 =item * accessurl, cost (if available).
703 =back
705 =cut
707 sub backend_confirm {
708 my ( $self, $params ) = @_;
710 my $response = $self->_backend->confirm({
711 request => $self,
712 other => $params,
714 return $self->expandTemplate($response);
717 =head3 backend_update_status
719 =cut
721 sub backend_update_status {
722 my ( $self, $params ) = @_;
723 return $self->expandTemplate($self->_backend->update_status($params));
726 =head3 backend_cancel
728 my $ILLResponse = $illRequest->backend_cancel;
730 The standard interface method allowing for request cancellation.
732 =cut
734 sub backend_cancel {
735 my ( $self, $params ) = @_;
737 my $result = $self->_backend->cancel({
738 request => $self,
739 other => $params
742 return $self->expandTemplate($result);
745 =head3 backend_renew
747 my $renew_response = $illRequest->backend_renew;
749 The standard interface method allowing for request renewal queries.
751 =cut
753 sub backend_renew {
754 my ( $self ) = @_;
755 return $self->expandTemplate(
756 $self->_backend->renew({
757 request => $self,
762 =head3 backend_create
764 my $create_response = $abstractILL->backend_create($params);
766 Return an array of Record objects created by querying our backend with
767 a Search query.
769 In the context of the other ILL methods, this is a special method: we only
770 pass it $params, as it does not yet have any other data associated with it.
772 =cut
774 sub backend_create {
775 my ( $self, $params ) = @_;
777 # Establish whether we need to do a generic copyright clearance.
778 if ($params->{opac}) {
779 if ( ( !$params->{stage} || $params->{stage} eq 'init' )
780 && C4::Context->preference("ILLModuleCopyrightClearance") ) {
781 return {
782 error => 0,
783 status => '',
784 message => '',
785 method => 'create',
786 stage => 'copyrightclearance',
787 value => {
788 backend => $self->_backend->name
791 } elsif ( defined $params->{stage}
792 && $params->{stage} eq 'copyrightclearance' ) {
793 $params->{stage} = 'init';
796 # First perform API action, then...
797 my $args = {
798 request => $self,
799 other => $params,
801 my $result = $self->_backend->create($args);
803 # ... simple case: we're not at 'commit' stage.
804 my $stage = $result->{stage};
805 return $self->expandTemplate($result)
806 unless ( 'commit' eq $stage );
808 # ... complex case: commit!
810 # Do we still have space for an ILL or should we queue?
811 my $permitted = $self->check_limits(
812 { patron => $self->patron }, { librarycode => $self->branchcode }
815 # Now augment our committed request.
817 $result->{permitted} = $permitted; # Queue request?
819 # This involves...
821 # ...Updating status!
822 $self->status('QUEUED')->store unless ( $permitted );
824 ## Handle Unmediated ILLs
826 # For the unmediated workflow we only need to delegate to our backend. If
827 # that backend supports unmediateld_ill, it will do its thing and return a
828 # proper response. If it doesn't then _backend_capability returns 0, so
829 # we keep the current result.
830 if ( C4::Context->preference("ILLModuleUnmediated") && $permitted ) {
831 my $unmediated_result = $self->_backend_capability(
832 'unmediated_ill',
833 $args
835 $result = $unmediated_result if $unmediated_result;
838 return $self->expandTemplate($result);
841 =head3 expandTemplate
843 my $params = $abstract->expandTemplate($params);
845 Return a version of $PARAMS augmented with our required template path.
847 =cut
849 sub expandTemplate {
850 my ( $self, $params ) = @_;
851 my $backend = $self->_backend->name;
852 # Generate path to file to load
853 my $backend_dir = $self->_config->backend_dir;
854 my $backend_tmpl = join "/", $backend_dir, $backend;
855 my $intra_tmpl = join "/", $backend_tmpl, "intra-includes",
856 $params->{method} . ".inc";
857 my $opac_tmpl = join "/", $backend_tmpl, "opac-includes",
858 $params->{method} . ".inc";
859 # Set files to load
860 $params->{template} = $intra_tmpl;
861 $params->{opac_template} = $opac_tmpl;
862 return $params;
865 #### Abstract Imports
867 =head3 getLimits
869 my $limit_rules = $abstract->getLimits( {
870 type => 'brw_cat' | 'branch',
871 value => $value
872 } );
874 Return the ILL limit rules for the supplied combination of type / value.
876 As the config may have no rules for this particular type / value combination,
877 or for the default, we must define fall-back values here.
879 =cut
881 sub getLimits {
882 my ( $self, $params ) = @_;
883 my $limits = $self->_config->getLimitRules($params->{type});
885 if ( defined $params->{value}
886 && defined $limits->{$params->{value}} ) {
887 return $limits->{$params->{value}};
889 else {
890 return $limits->{default} || { count => -1, method => 'active' };
894 =head3 getPrefix
896 my $prefix = $abstract->getPrefix( {
897 branch => $branch_code
898 } );
900 Return the ILL prefix as defined by our $params: either per borrower category,
901 per branch or the default.
903 =cut
905 sub getPrefix {
906 my ( $self, $params ) = @_;
907 my $brn_prefixes = $self->_config->getPrefixes();
908 return $brn_prefixes->{$params->{branch}} || ""; # "the empty prefix"
911 =head3 get_type
913 my $type = $abstract->get_type();
915 Return a string representing the material type of this request or undef
917 =cut
919 sub get_type {
920 my ($self) = @_;
921 my $attr = $self->illrequestattributes->find({ type => 'type'});
922 return if !$attr;
923 return $attr->value;
926 #### Illrequests Imports
928 =head3 check_limits
930 my $ok = $illRequests->check_limits( {
931 borrower => $borrower,
932 branchcode => 'branchcode' | undef,
933 } );
935 Given $PARAMS, a hashref containing a $borrower object and a $branchcode,
936 see whether we are still able to place ILLs.
938 LimitRules are derived from koha-conf.xml:
939 + default limit counts, and counting method
940 + branch specific limit counts & counting method
941 + borrower category specific limit counts & counting method
942 + err on the side of caution: a counting fail will cause fail, even if
943 the other counts passes.
945 =cut
947 sub check_limits {
948 my ( $self, $params ) = @_;
949 my $patron = $params->{patron};
950 my $branchcode = $params->{librarycode} || $patron->branchcode;
952 # Establish maximum number of allowed requests
953 my ( $branch_rules, $brw_rules ) = (
954 $self->getLimits( {
955 type => 'branch',
956 value => $branchcode
957 } ),
958 $self->getLimits( {
959 type => 'brw_cat',
960 value => $patron->categorycode,
961 } ),
963 my ( $branch_limit, $brw_limit )
964 = ( $branch_rules->{count}, $brw_rules->{count} );
965 # Establish currently existing requests
966 my ( $branch_count, $brw_count ) = (
967 $self->_limit_counter(
968 $branch_rules->{method}, { branchcode => $branchcode }
970 $self->_limit_counter(
971 $brw_rules->{method}, { borrowernumber => $patron->borrowernumber }
975 # Compare and return
976 # A limit of -1 means no limit exists.
977 # We return blocked if either branch limit or brw limit is reached.
978 if ( ( $branch_limit != -1 && $branch_limit <= $branch_count )
979 || ( $brw_limit != -1 && $brw_limit <= $brw_count ) ) {
980 return 0;
981 } else {
982 return 1;
986 sub _limit_counter {
987 my ( $self, $method, $target ) = @_;
989 # Establish parameters of counts
990 my $resultset;
991 if ($method && $method eq 'annual') {
992 $resultset = Koha::Illrequests->search({
993 -and => [
994 %{$target},
995 \"YEAR(placed) = YEAR(NOW())"
998 } else { # assume 'active'
999 # XXX: This status list is ugly. There should be a method in config
1000 # to return these.
1001 my $where = { status => { -not_in => [ 'QUEUED', 'COMP' ] } };
1002 $resultset = Koha::Illrequests->search({ %{$target}, %{$where} });
1005 # Fetch counts
1006 return $resultset->count;
1009 =head3 requires_moderation
1011 my $status = $illRequest->requires_moderation;
1013 Return the name of the status if moderation by staff is required; or 0
1014 otherwise.
1016 =cut
1018 sub requires_moderation {
1019 my ( $self ) = @_;
1020 my $require_moderation = {
1021 'CANCREQ' => 'CANCREQ',
1023 return $require_moderation->{$self->status};
1026 =head3 generic_confirm
1028 my $stage_summary = $illRequest->generic_confirm;
1030 Handle the generic_confirm extended method. The first stage involves creating
1031 a template email for the end user to edit in the browser. The second stage
1032 attempts to submit the email.
1034 =cut
1036 sub generic_confirm {
1037 my ( $self, $params ) = @_;
1038 my $branch = Koha::Libraries->find($params->{current_branchcode})
1039 || die "Invalid current branchcode. Are you logged in as the database user?";
1040 if ( !$params->{stage}|| $params->{stage} eq 'init' ) {
1041 my $draft->{subject} = "ILL Request";
1042 $draft->{body} = <<EOF;
1043 Dear Sir/Madam,
1045 We would like to request an interlibrary loan for a title matching the
1046 following description:
1050 my $details = $self->metadata;
1051 while (my ($title, $value) = each %{$details}) {
1052 $draft->{body} .= " - " . $title . ": " . $value . "\n"
1053 if $value;
1055 $draft->{body} .= <<EOF;
1057 Please let us know if you are able to supply this to us.
1059 Kind Regards
1063 my @address = map { $branch->$_ }
1064 qw/ branchname branchaddress1 branchaddress2 branchaddress3
1065 branchzip branchcity branchstate branchcountry branchphone
1066 branchemail /;
1067 my $address = "";
1068 foreach my $line ( @address ) {
1069 $address .= $line . "\n" if $line;
1072 $draft->{body} .= $address;
1074 my $partners = Koha::Patrons->search({
1075 categorycode => $self->_config->partner_code
1077 return {
1078 error => 0,
1079 status => '',
1080 message => '',
1081 method => 'generic_confirm',
1082 stage => 'draft',
1083 value => {
1084 draft => $draft,
1085 partners => $partners,
1089 } elsif ( 'draft' eq $params->{stage} ) {
1090 # Create the to header
1091 my $to = $params->{partners};
1092 if ( defined $to ) {
1093 $to =~ s/^\x00//; # Strip leading NULLs
1094 $to =~ s/\x00/; /; # Replace others with '; '
1096 Koha::Exceptions::Ill::NoTargetEmail->throw(
1097 "No target email addresses found. Either select at least one partner or check your ILL partner library records.")
1098 if ( !$to );
1099 # Create the from, replyto and sender headers
1100 my $from = $branch->branchemail;
1101 my $replyto = $branch->branchreplyto || $from;
1102 Koha::Exceptions::Ill::NoLibraryEmail->throw(
1103 "Your library has no usable email address. Please set it.")
1104 if ( !$from );
1106 # Create the email
1107 my $message = Koha::Email->new;
1108 my %mail = $message->create_message_headers(
1110 to => $to,
1111 from => $from,
1112 replyto => $replyto,
1113 subject => Encode::encode( "utf8", $params->{subject} ),
1114 message => Encode::encode( "utf8", $params->{body} ),
1115 contenttype => 'text/plain',
1118 # Send it
1119 my $result = sendmail(%mail);
1120 if ( $result ) {
1121 $self->status("GENREQ")->store;
1122 $self->_backend_capability(
1123 'set_requested_partners',
1125 request => $self,
1126 to => $to
1129 return {
1130 error => 0,
1131 status => '',
1132 message => '',
1133 method => 'generic_confirm',
1134 stage => 'commit',
1135 next => 'illview',
1137 } else {
1138 return {
1139 error => 1,
1140 status => 'email_failed',
1141 message => $Mail::Sendmail::error,
1142 method => 'generic_confirm',
1143 stage => 'draft',
1146 } else {
1147 die "Unknown stage, should not have happened."
1151 =head3 id_prefix
1153 my $prefix = $record->id_prefix;
1155 Return the prefix appropriate for the current Illrequest as derived from the
1156 borrower and branch associated with this request's Status, and the config
1157 file.
1159 =cut
1161 sub id_prefix {
1162 my ( $self ) = @_;
1163 my $prefix = $self->getPrefix( {
1164 branch => $self->branchcode,
1165 } );
1166 $prefix .= "-" if ( $prefix );
1167 return $prefix;
1170 =head3 _censor
1172 my $params = $illRequest->_censor($params);
1174 Return $params, modified to reflect our censorship requirements.
1176 =cut
1178 sub _censor {
1179 my ( $self, $params ) = @_;
1180 my $censorship = $self->_config->censorship;
1181 $params->{censor_notes_staff} = $censorship->{censor_notes_staff}
1182 if ( $params->{opac} );
1183 $params->{display_reply_date} = ( $censorship->{censor_reply_date} ) ? 0 : 1;
1185 return $params;
1188 =head3 store
1190 $Illrequest->store;
1192 Overloaded I<store> method that, in addition to performing the 'store',
1193 possibly records the fact that something happened
1195 =cut
1197 sub store {
1198 my ( $self, $attrs ) = @_;
1200 my $ret = $self->SUPER::store;
1202 $attrs->{log_origin} = 'core';
1204 if ($ret && defined $attrs) {
1205 my $logger = Koha::Illrequest::Logger->new;
1206 $logger->log_maybe({
1207 request => $self,
1208 attrs => $attrs
1212 return $ret;
1215 =head3 requested_partners
1217 my $partners_string = $illRequest->requested_partners;
1219 Return the string representing the email addresses of the partners to
1220 whom a request has been sent
1222 =cut
1224 sub requested_partners {
1225 my ( $self ) = @_;
1226 return $self->_backend_capability(
1227 'get_requested_partners',
1228 { request => $self }
1232 =head3 TO_JSON
1234 $json = $illrequest->TO_JSON
1236 Overloaded I<TO_JSON> method that takes care of inserting calculated values
1237 into the unblessed representation of the object.
1239 TODO: This method does nothing and is not called anywhere. However, bug 74325
1240 touches it, so keeping this for now until both this and bug 74325 are merged,
1241 at which point we can sort it out and remove it completely
1243 =cut
1245 sub TO_JSON {
1246 my ( $self, $embed ) = @_;
1248 my $object = $self->SUPER::TO_JSON();
1250 return $object;
1253 =head2 Internal methods
1255 =head3 _type
1257 =cut
1259 sub _type {
1260 return 'Illrequest';
1263 =head1 AUTHOR
1265 Alex Sassmannshausen <alex.sassmannshausen@ptfs-europe.com>
1266 Andrew Isherwood <andrew.isherwood@ptfs-europe.com>
1268 =cut