Bug 26922: Regression tests
[koha.git] / Koha / Illrequest.pm
blob39cf0eabf8debeb102d5f9fbbdc285ea037b1299
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
8 # under the terms of the GNU General Public License as published by
9 # the Free Software Foundation; either version 3 of the License, or
10 # (at your option) any later version.
12 # Koha is distributed in the hope that it will be useful, but
13 # WITHOUT ANY WARRANTY; without even the implied warranty of
14 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 # GNU General Public License for more details.
17 # You should have received a copy of the GNU General Public License
18 # along with Koha; if not, see <http://www.gnu.org/licenses>.
20 use Modern::Perl;
22 use Clone 'clone';
23 use File::Basename qw( basename );
24 use Encode qw( encode );
25 use Try::Tiny;
26 use DateTime;
28 use C4::Letters;
29 use C4::Members;
30 use Koha::Database;
31 use Koha::DateUtils qw/ dt_from_string /;
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;
39 use Koha::Biblios;
40 use Koha::Items;
41 use Koha::ItemTypes;
42 use Koha::Libraries;
44 use C4::Circulation qw( CanBookBeIssued AddIssue );
46 use base qw(Koha::Object);
48 =head1 NAME
50 Koha::Illrequest - Koha Illrequest Object class
52 =head1 (Re)Design
54 An ILLRequest consists of two parts; the Illrequest Koha::Object, and a series
55 of related Illrequestattributes.
57 The former encapsulates the basic necessary information that any ILL requires
58 to be usable in Koha. The latter is a set of additional properties used by
59 one of the backends.
61 The former subsumes the legacy "Status" object. The latter remains
62 encapsulated in the "Record" object.
64 TODO:
66 - Anything invoking the ->status method; annotated with:
67 + # Old use of ->status !
69 =head1 API
71 =head2 Backend API Response Principles
73 All methods should return a hashref in the following format:
75 =over
77 =item * error
79 This should be set to 1 if an error was encountered.
81 =item * status
83 The status should be a string from the list of statuses detailed below.
85 =item * message
87 The message is a free text field that can be passed on to the end user.
89 =item * value
91 The value returned by the method.
93 =back
95 =head2 Interface Status Messages
97 =over
99 =item * branch_address_incomplete
101 An interface request has determined branch address details are incomplete.
103 =item * cancel_success
105 The interface's cancel_request method was successful in cancelling the
106 Illrequest using the API.
108 =item * cancel_fail
110 The interface's cancel_request method failed to cancel the Illrequest using
111 the API.
113 =item * unavailable
115 The interface's request method returned saying that the desired item is not
116 available for request.
118 =back
120 =head2 Class methods
122 =head3 statusalias
124 my $statusalias = $request->statusalias;
126 Returns a request's status alias, as a Koha::AuthorisedValue instance
127 or implicit undef. This is distinct from status_alias, which only returns
128 the value in the status_alias column, this method returns the entire
129 AuthorisedValue object
131 =cut
133 sub statusalias {
134 my ( $self ) = @_;
135 return unless $self->status_alias;
136 # We can't know which result is the right one if there are multiple
137 # ILLSTATUS authorised values with the same authorised_value column value
138 # so we just use the first
139 return Koha::AuthorisedValues->search({
140 branchcode => $self->branchcode,
141 category => 'ILLSTATUS',
142 authorised_value => $self->SUPER::status_alias
143 })->next;
146 =head3 illrequestattributes
148 =cut
150 sub illrequestattributes {
151 my ( $self ) = @_;
152 return Koha::Illrequestattributes->_new_from_dbic(
153 scalar $self->_result->illrequestattributes
157 =head3 illcomments
159 =cut
161 sub illcomments {
162 my ( $self ) = @_;
163 return Koha::Illcomments->_new_from_dbic(
164 scalar $self->_result->illcomments
168 =head3 logs
170 =cut
172 sub logs {
173 my ( $self ) = @_;
174 my $logger = Koha::Illrequest::Logger->new;
175 return $logger->get_request_logs($self);
178 =head3 patron
180 =cut
182 sub patron {
183 my ( $self ) = @_;
184 return Koha::Patron->_new_from_dbic(
185 scalar $self->_result->borrowernumber
189 =head3 status_alias
191 $Illrequest->status_alias(143);
193 Overloaded getter/setter for status_alias,
194 that only returns authorised values from the
195 correct category and records the fact that the status has changed
197 =cut
199 sub status_alias {
200 my ($self, $new_status_alias) = @_;
202 my $current_status_alias = $self->SUPER::status_alias;
204 if ($new_status_alias) {
205 # Keep a record of the previous status before we change it,
206 # we might need it
207 $self->{previous_status} = $current_status_alias ?
208 $current_status_alias :
209 scalar $self->status;
210 # This is hackery to enable us to undefine
211 # status_alias, since we need to have an overloaded
212 # status_alias method to get us around the problem described
213 # here:
214 # https://bugs.koha-community.org/bugzilla3/show_bug.cgi?id=20581#c156
215 # We need a way of accepting implied undef, so we can nullify
216 # the status_alias column, when called from $self->status
217 my $val = $new_status_alias eq "-1" ? undef : $new_status_alias;
218 my $ret = $self->SUPER::status_alias($val);
219 my $val_to_log = $val ? $new_status_alias : scalar $self->status;
220 if ($ret) {
221 my $logger = Koha::Illrequest::Logger->new;
222 $logger->log_status_change({
223 request => $self,
224 value => $val_to_log
226 } else {
227 delete $self->{previous_status};
229 return $ret;
231 # We can't know which result is the right one if there are multiple
232 # ILLSTATUS authorised values with the same authorised_value column value
233 # so we just use the first
234 my $alias = Koha::AuthorisedValues->search({
235 branchcode => $self->branchcode,
236 category => 'ILLSTATUS',
237 authorised_value => $self->SUPER::status_alias
238 })->next;
239 if ($alias) {
240 return $alias->authorised_value;
241 } else {
242 return;
246 =head3 status
248 $Illrequest->status('CANREQ');
250 Overloaded getter/setter for request status,
251 also nullifies status_alias and records the fact that the status has changed
252 and sends a notice if appropriate
254 =cut
256 sub status {
257 my ( $self, $new_status) = @_;
259 my $current_status = $self->SUPER::status;
260 my $current_status_alias = $self->SUPER::status_alias;
262 if ($new_status) {
263 # Keep a record of the previous status before we change it,
264 # we might need it
265 $self->{previous_status} = $current_status_alias ?
266 $current_status_alias :
267 $current_status;
268 my $ret = $self->SUPER::status($new_status)->store;
269 if ($current_status_alias) {
270 # This is hackery to enable us to undefine
271 # status_alias, since we need to have an overloaded
272 # status_alias method to get us around the problem described
273 # here:
274 # https://bugs.koha-community.org/bugzilla3/show_bug.cgi?id=20581#c156
275 # We need a way of passing implied undef to nullify status_alias
276 # so we pass -1, which is special cased in the overloaded setter
277 $self->status_alias("-1");
278 } else {
279 my $logger = Koha::Illrequest::Logger->new;
280 $logger->log_status_change({
281 request => $self,
282 value => $new_status
285 delete $self->{previous_status};
286 # If status has changed to cancellation requested, send a notice
287 if ($new_status eq 'CANCREQ') {
288 $self->send_staff_notice('ILL_REQUEST_CANCEL');
290 return $ret;
291 } else {
292 return $current_status;
296 =head3 load_backend
298 Require "Base.pm" from the relevant ILL backend.
300 =cut
302 sub load_backend {
303 my ( $self, $backend_id ) = @_;
305 my @raw = qw/Koha Illbackends/; # Base Path
307 my $backend_name = $backend_id || $self->backend;
309 unless ( defined $backend_name && $backend_name ne '' ) {
310 Koha::Exceptions::Ill::InvalidBackendId->throw(
311 "An invalid backend ID was requested ('')");
314 my $location = join "/", @raw, $backend_name, "Base.pm"; # File to load
315 my $backend_class = join "::", @raw, $backend_name, "Base"; # Package name
316 require $location;
317 $self->{_my_backend} = $backend_class->new({
318 config => $self->_config,
319 logger => Koha::Illrequest::Logger->new
321 return $self;
325 =head3 _backend
327 my $backend = $abstract->_backend($new_backend);
328 my $backend = $abstract->_backend;
330 Getter/Setter for our API object.
332 =cut
334 sub _backend {
335 my ( $self, $backend ) = @_;
336 $self->{_my_backend} = $backend if ( $backend );
337 # Dynamically load our backend object, as late as possible.
338 $self->load_backend unless ( $self->{_my_backend} );
339 return $self->{_my_backend};
342 =head3 _backend_capability
344 my $backend_capability_result = $self->_backend_capability($name, $args);
346 This is a helper method to invoke optional capabilities in the backend. If
347 the capability named by $name is not supported, return 0, else invoke it,
348 passing $args along with the invocation, and return its return value.
350 NOTE: this module suffers from a confusion in termninology:
352 in _backend_capability, the notion of capability refers to an optional feature
353 that is implemented in core, but might not be supported by a given backend.
355 in capabilities & custom_capability, capability refers to entries in the
356 status_graph (after union between backend and core).
358 The easiest way to fix this would be to fix the terminology in
359 capabilities & custom_capability and their callers.
361 =cut
363 sub _backend_capability {
364 my ( $self, $name, $args ) = @_;
365 my $capability = 0;
366 # See if capability is defined in backend
367 try {
368 $capability = $self->_backend->capabilities($name);
369 } catch {
370 return 0;
372 # Try to invoke it
373 if ( $capability && ref($capability) eq 'CODE' ) {
374 return &{$capability}($args);
375 } else {
376 return 0;
380 =head3 _config
382 my $config = $abstract->_config($config);
383 my $config = $abstract->_config;
385 Getter/Setter for our config object.
387 =cut
389 sub _config {
390 my ( $self, $config ) = @_;
391 $self->{_my_config} = $config if ( $config );
392 # Load our config object, as late as possible.
393 unless ( $self->{_my_config} ) {
394 $self->{_my_config} = Koha::Illrequest::Config->new;
396 return $self->{_my_config};
399 =head3 metadata
401 =cut
403 sub metadata {
404 my ( $self ) = @_;
405 return $self->_backend->metadata($self);
408 =head3 _core_status_graph
410 my $core_status_graph = $illrequest->_core_status_graph;
412 Returns ILL module's default status graph. A status graph defines the list of
413 available actions at any stage in the ILL workflow. This is for instance used
414 by the perl script & template to generate the correct buttons to display to
415 the end user at any given point.
417 =cut
419 sub _core_status_graph {
420 my ( $self ) = @_;
421 return {
422 NEW => {
423 prev_actions => [ ], # Actions containing buttons
424 # leading to this status
425 id => 'NEW', # ID of this status
426 name => 'New request', # UI name of this status
427 ui_method_name => 'New request', # UI name of method leading
428 # to this status
429 method => 'create', # method to this status
430 next_actions => [ 'REQ', 'GENREQ', 'KILL' ], # buttons to add to all
431 # requests with this status
432 ui_method_icon => 'fa-plus', # UI Style class
434 REQ => {
435 prev_actions => [ 'NEW', 'REQREV', 'QUEUED', 'CANCREQ' ],
436 id => 'REQ',
437 name => 'Requested',
438 ui_method_name => 'Confirm request',
439 method => 'confirm',
440 next_actions => [ 'REQREV', 'COMP', 'CHK' ],
441 ui_method_icon => 'fa-check',
443 GENREQ => {
444 prev_actions => [ 'NEW', 'REQREV' ],
445 id => 'GENREQ',
446 name => 'Requested from partners',
447 ui_method_name => 'Place request with partners',
448 method => 'generic_confirm',
449 next_actions => [ 'COMP', 'CHK' ],
450 ui_method_icon => 'fa-send-o',
452 REQREV => {
453 prev_actions => [ 'REQ' ],
454 id => 'REQREV',
455 name => 'Request reverted',
456 ui_method_name => 'Revert Request',
457 method => 'cancel',
458 next_actions => [ 'REQ', 'GENREQ', 'KILL' ],
459 ui_method_icon => 'fa-times',
461 QUEUED => {
462 prev_actions => [ ],
463 id => 'QUEUED',
464 name => 'Queued request',
465 ui_method_name => 0,
466 method => 0,
467 next_actions => [ 'REQ', 'KILL' ],
468 ui_method_icon => 0,
470 CANCREQ => {
471 prev_actions => [ 'NEW' ],
472 id => 'CANCREQ',
473 name => 'Cancellation requested',
474 ui_method_name => 0,
475 method => 0,
476 next_actions => [ 'KILL', 'REQ' ],
477 ui_method_icon => 0,
479 COMP => {
480 prev_actions => [ 'REQ' ],
481 id => 'COMP',
482 name => 'Completed',
483 ui_method_name => 'Mark completed',
484 method => 'mark_completed',
485 next_actions => [ 'CHK' ],
486 ui_method_icon => 'fa-check',
488 KILL => {
489 prev_actions => [ 'QUEUED', 'REQREV', 'NEW', 'CANCREQ' ],
490 id => 'KILL',
491 name => 0,
492 ui_method_name => 'Delete request',
493 method => 'delete',
494 next_actions => [ ],
495 ui_method_icon => 'fa-trash',
497 CHK => {
498 prev_actions => [ 'REQ', 'GENREQ', 'COMP' ],
499 id => 'CHK',
500 name => 'Checked out',
501 ui_method_name => 'Check out',
502 needs_prefs => [ 'CirculateILL' ],
503 needs_perms => [ 'user_circulate_circulate_remaining_permissions' ],
504 # An array of functions that all must return true
505 needs_all => [ sub { my $r = shift; return $r->biblio; } ],
506 method => 'check_out',
507 next_actions => [ ],
508 ui_method_icon => 'fa-upload',
510 RET => {
511 prev_actions => [ 'CHK' ],
512 id => 'RET',
513 name => 'Returned to library',
514 ui_method_name => 'Check in',
515 method => 'check_in',
516 next_actions => [ 'COMP' ],
517 ui_method_icon => 'fa-download',
522 =head3 _status_graph_union
524 my $status_graph = $illrequest->_status_graph_union($origin, $new_graph);
526 Return a new status_graph, the result of merging $origin & new_graph. This is
527 operation is a union over the sets defied by the two graphs.
529 Each entry in $new_graph is added to $origin. We do not provide a syntax for
530 'subtraction' of entries from $origin.
532 Whilst it is not intended that this works, you can override entries in $origin
533 with entries with the same key in $new_graph. This can lead to problematic
534 behaviour when $new_graph adds an entry, which modifies a dependent entry in
535 $origin, only for the entry in $origin to be replaced later with a new entry
536 from $new_graph.
538 NOTE: this procedure does not "re-link" entries in $origin or $new_graph,
539 i.e. each of the graphs need to be correct at the outset of the operation.
541 =cut
543 sub _status_graph_union {
544 my ( $self, $core_status_graph, $backend_status_graph ) = @_;
545 # Create new status graph with:
546 # - all core_status_graph
547 # - for-each each backend_status_graph
548 # + add to new status graph
549 # + for each core prev_action:
550 # * locate core_status
551 # * update next_actions with additional next action.
552 # + for each core next_action:
553 # * locate core_status
554 # * update prev_actions with additional prev action
556 my @core_status_ids = keys %{$core_status_graph};
557 my $status_graph = clone($core_status_graph);
559 foreach my $backend_status_key ( keys %{$backend_status_graph} ) {
560 my $backend_status = $backend_status_graph->{$backend_status_key};
561 # Add to new status graph
562 $status_graph->{$backend_status_key} = $backend_status;
563 # Update all core methods' next_actions.
564 foreach my $prev_action ( @{$backend_status->{prev_actions}} ) {
565 if ( grep { $prev_action eq $_ } @core_status_ids ) {
566 my @next_actions =
567 @{$status_graph->{$prev_action}->{next_actions}};
568 push @next_actions, $backend_status_key;
569 $status_graph->{$prev_action}->{next_actions}
570 = \@next_actions;
573 # Update all core methods' prev_actions
574 foreach my $next_action ( @{$backend_status->{next_actions}} ) {
575 if ( grep { $next_action eq $_ } @core_status_ids ) {
576 my @prev_actions =
577 @{$status_graph->{$next_action}->{prev_actions}};
578 push @prev_actions, $backend_status_key;
579 $status_graph->{$next_action}->{prev_actions}
580 = \@prev_actions;
585 return $status_graph;
588 ### Core API methods
590 =head3 capabilities
592 my $capabilities = $illrequest->capabilities;
594 Return a hashref mapping methods to operation names supported by the queried
595 backend.
597 Example return value:
599 { create => "Create Request", confirm => "Progress Request" }
601 NOTE: this module suffers from a confusion in termninology:
603 in _backend_capability, the notion of capability refers to an optional feature
604 that is implemented in core, but might not be supported by a given backend.
606 in capabilities & custom_capability, capability refers to entries in the
607 status_graph (after union between backend and core).
609 The easiest way to fix this would be to fix the terminology in
610 capabilities & custom_capability and their callers.
612 =cut
614 sub capabilities {
615 my ( $self, $status ) = @_;
616 # Generate up to date status_graph
617 my $status_graph = $self->_status_graph_union(
618 $self->_core_status_graph,
619 $self->_backend->status_graph({
620 request => $self,
621 other => {}
624 # Extract available actions from graph.
625 return $status_graph->{$status} if $status;
626 # Or return entire graph.
627 return $status_graph;
630 =head3 custom_capability
632 Return the result of invoking $CANDIDATE on this request's backend with
633 $PARAMS, or 0 if $CANDIDATE is an unknown method on backend.
635 NOTE: this module suffers from a confusion in termninology:
637 in _backend_capability, the notion of capability refers to an optional feature
638 that is implemented in core, but might not be supported by a given backend.
640 in capabilities & custom_capability, capability refers to entries in the
641 status_graph (after union between backend and core).
643 The easiest way to fix this would be to fix the terminology in
644 capabilities & custom_capability and their callers.
646 =cut
648 sub custom_capability {
649 my ( $self, $candidate, $params ) = @_;
650 foreach my $capability ( values %{$self->capabilities} ) {
651 if ( $candidate eq $capability->{method} ) {
652 my $response =
653 $self->_backend->$candidate({
654 request => $self,
655 other => $params,
657 return $self->expandTemplate($response);
660 return 0;
663 =head3 available_backends
665 Return a list of available backends.
667 =cut
669 sub available_backends {
670 my ( $self, $reduced ) = @_;
671 my $backends = $self->_config->available_backends($reduced);
672 return $backends;
675 =head3 available_actions
677 Return a list of available actions.
679 =cut
681 sub available_actions {
682 my ( $self ) = @_;
683 my $current_action = $self->capabilities($self->status);
684 my @available_actions = map { $self->capabilities($_) }
685 @{$current_action->{next_actions}};
686 return \@available_actions;
689 =head3 mark_completed
691 Mark a request as completed (status = COMP).
693 =cut
695 sub mark_completed {
696 my ( $self ) = @_;
697 $self->status('COMP')->store;
698 $self->completed(dt_from_string())->store;
699 return {
700 error => 0,
701 status => '',
702 message => '',
703 method => 'mark_completed',
704 stage => 'commit',
705 next => 'illview',
709 =head2 backend_migrate
711 Migrate a request from one backend to another.
713 =cut
715 sub backend_migrate {
716 my ( $self, $params ) = @_;
718 my $response = $self->_backend_capability('migrate',{
719 request => $self,
720 other => $params,
722 return $self->expandTemplate($response) if $response;
723 return $response;
726 =head2 backend_confirm
728 Confirm a request. The backend handles setting of mandatory fields in the commit stage:
730 =over
732 =item * orderid
734 =item * accessurl, cost (if available).
736 =back
738 =cut
740 sub backend_confirm {
741 my ( $self, $params ) = @_;
743 my $response = $self->_backend->confirm({
744 request => $self,
745 other => $params,
747 return $self->expandTemplate($response);
750 =head3 backend_update_status
752 =cut
754 sub backend_update_status {
755 my ( $self, $params ) = @_;
756 return $self->expandTemplate($self->_backend->update_status($params));
759 =head3 backend_cancel
761 my $ILLResponse = $illRequest->backend_cancel;
763 The standard interface method allowing for request cancellation.
765 =cut
767 sub backend_cancel {
768 my ( $self, $params ) = @_;
770 my $result = $self->_backend->cancel({
771 request => $self,
772 other => $params
775 return $self->expandTemplate($result);
778 =head3 backend_renew
780 my $renew_response = $illRequest->backend_renew;
782 The standard interface method allowing for request renewal queries.
784 =cut
786 sub backend_renew {
787 my ( $self ) = @_;
788 return $self->expandTemplate(
789 $self->_backend->renew({
790 request => $self,
795 =head3 backend_create
797 my $create_response = $abstractILL->backend_create($params);
799 Return an array of Record objects created by querying our backend with
800 a Search query.
802 In the context of the other ILL methods, this is a special method: we only
803 pass it $params, as it does not yet have any other data associated with it.
805 =cut
807 sub backend_create {
808 my ( $self, $params ) = @_;
810 # Establish whether we need to do a generic copyright clearance.
811 if ($params->{opac}) {
812 if ( ( !$params->{stage} || $params->{stage} eq 'init' )
813 && C4::Context->preference("ILLModuleCopyrightClearance") ) {
814 return {
815 error => 0,
816 status => '',
817 message => '',
818 method => 'create',
819 stage => 'copyrightclearance',
820 value => {
821 other => $params,
822 backend => $self->_backend->name
825 } elsif ( defined $params->{stage}
826 && $params->{stage} eq 'copyrightclearance' ) {
827 $params->{stage} = 'init';
830 # First perform API action, then...
831 my $args = {
832 request => $self,
833 other => $params,
835 my $result = $self->_backend->create($args);
837 # ... simple case: we're not at 'commit' stage.
838 my $stage = $result->{stage};
839 return $self->expandTemplate($result)
840 unless ( 'commit' eq $stage );
842 # ... complex case: commit!
844 # Do we still have space for an ILL or should we queue?
845 my $permitted = $self->check_limits(
846 { patron => $self->patron }, { librarycode => $self->branchcode }
849 # Now augment our committed request.
851 $result->{permitted} = $permitted; # Queue request?
853 # This involves...
855 # ...Updating status!
856 $self->status('QUEUED')->store unless ( $permitted );
858 ## Handle Unmediated ILLs
860 # For the unmediated workflow we only need to delegate to our backend. If
861 # that backend supports unmediateld_ill, it will do its thing and return a
862 # proper response. If it doesn't then _backend_capability returns 0, so
863 # we keep the current result.
864 if ( C4::Context->preference("ILLModuleUnmediated") && $permitted ) {
865 my $unmediated_result = $self->_backend_capability(
866 'unmediated_ill',
867 $args
869 $result = $unmediated_result if $unmediated_result;
872 return $self->expandTemplate($result);
875 =head3 expandTemplate
877 my $params = $abstract->expandTemplate($params);
879 Return a version of $PARAMS augmented with our required template path.
881 =cut
883 sub expandTemplate {
884 my ( $self, $params ) = @_;
885 my $backend = $self->_backend->name;
886 # Generate path to file to load
887 my $backend_dir = $self->_config->backend_dir;
888 my $backend_tmpl = join "/", $backend_dir, $backend;
889 my $intra_tmpl = join "/", $backend_tmpl, "intra-includes",
890 ( $params->{method}//q{} ) . ".inc";
891 my $opac_tmpl = join "/", $backend_tmpl, "opac-includes",
892 ( $params->{method}//q{} ) . ".inc";
893 # Set files to load
894 $params->{template} = $intra_tmpl;
895 $params->{opac_template} = $opac_tmpl;
896 return $params;
899 #### Abstract Imports
901 =head3 getLimits
903 my $limit_rules = $abstract->getLimits( {
904 type => 'brw_cat' | 'branch',
905 value => $value
906 } );
908 Return the ILL limit rules for the supplied combination of type / value.
910 As the config may have no rules for this particular type / value combination,
911 or for the default, we must define fall-back values here.
913 =cut
915 sub getLimits {
916 my ( $self, $params ) = @_;
917 my $limits = $self->_config->getLimitRules($params->{type});
919 if ( defined $params->{value}
920 && defined $limits->{$params->{value}} ) {
921 return $limits->{$params->{value}};
923 else {
924 return $limits->{default} || { count => -1, method => 'active' };
928 =head3 getPrefix
930 my $prefix = $abstract->getPrefix( {
931 branch => $branch_code
932 } );
934 Return the ILL prefix as defined by our $params: either per borrower category,
935 per branch or the default.
937 =cut
939 sub getPrefix {
940 my ( $self, $params ) = @_;
941 my $brn_prefixes = $self->_config->getPrefixes();
942 return $brn_prefixes->{$params->{branch}} || ""; # "the empty prefix"
945 =head3 get_type
947 my $type = $abstract->get_type();
949 Return a string representing the material type of this request or undef
951 =cut
953 sub get_type {
954 my ($self) = @_;
955 my $attr = $self->illrequestattributes->find({ type => 'type'});
956 return if !$attr;
957 return $attr->value;
960 #### Illrequests Imports
962 =head3 check_limits
964 my $ok = $illRequests->check_limits( {
965 borrower => $borrower,
966 branchcode => 'branchcode' | undef,
967 } );
969 Given $PARAMS, a hashref containing a $borrower object and a $branchcode,
970 see whether we are still able to place ILLs.
972 LimitRules are derived from koha-conf.xml:
973 + default limit counts, and counting method
974 + branch specific limit counts & counting method
975 + borrower category specific limit counts & counting method
976 + err on the side of caution: a counting fail will cause fail, even if
977 the other counts passes.
979 =cut
981 sub check_limits {
982 my ( $self, $params ) = @_;
983 my $patron = $params->{patron};
984 my $branchcode = $params->{librarycode} || $patron->branchcode;
986 # Establish maximum number of allowed requests
987 my ( $branch_rules, $brw_rules ) = (
988 $self->getLimits( {
989 type => 'branch',
990 value => $branchcode
991 } ),
992 $self->getLimits( {
993 type => 'brw_cat',
994 value => $patron->categorycode,
995 } ),
997 my ( $branch_limit, $brw_limit )
998 = ( $branch_rules->{count}, $brw_rules->{count} );
999 # Establish currently existing requests
1000 my ( $branch_count, $brw_count ) = (
1001 $self->_limit_counter(
1002 $branch_rules->{method}, { branchcode => $branchcode }
1004 $self->_limit_counter(
1005 $brw_rules->{method}, { borrowernumber => $patron->borrowernumber }
1009 # Compare and return
1010 # A limit of -1 means no limit exists.
1011 # We return blocked if either branch limit or brw limit is reached.
1012 if ( ( $branch_limit != -1 && $branch_limit <= $branch_count )
1013 || ( $brw_limit != -1 && $brw_limit <= $brw_count ) ) {
1014 return 0;
1015 } else {
1016 return 1;
1020 sub _limit_counter {
1021 my ( $self, $method, $target ) = @_;
1023 # Establish parameters of counts
1024 my $resultset;
1025 if ($method && $method eq 'annual') {
1026 $resultset = Koha::Illrequests->search({
1027 -and => [
1028 %{$target},
1029 \"YEAR(placed) = YEAR(NOW())"
1032 } else { # assume 'active'
1033 # XXX: This status list is ugly. There should be a method in config
1034 # to return these.
1035 my $where = { status => { -not_in => [ 'QUEUED', 'COMP' ] } };
1036 $resultset = Koha::Illrequests->search({ %{$target}, %{$where} });
1039 # Fetch counts
1040 return $resultset->count;
1043 =head3 requires_moderation
1045 my $status = $illRequest->requires_moderation;
1047 Return the name of the status if moderation by staff is required; or 0
1048 otherwise.
1050 =cut
1052 sub requires_moderation {
1053 my ( $self ) = @_;
1054 my $require_moderation = {
1055 'CANCREQ' => 'CANCREQ',
1057 return $require_moderation->{$self->status};
1060 =head3 biblio
1062 my $biblio = $request->biblio;
1064 For a given request, return the biblio associated with it,
1065 or undef if none exists
1067 =cut
1069 sub biblio {
1070 my ( $self ) = @_;
1072 return if !$self->biblio_id;
1074 return Koha::Biblios->find({
1075 biblionumber => $self->biblio_id
1079 =head3 check_out
1081 my $stage_summary = $request->check_out;
1083 Handle the check_out method. The first stage involves gathering the required
1084 data from the user via a form, the second stage creates an item and tries to
1085 issue it to the patron. If successful, it notifies the patron, then it
1086 returns a summary of how things went
1088 =cut
1090 sub check_out {
1091 my ( $self, $params ) = @_;
1093 # Objects required by the template
1094 my $itemtypes = Koha::ItemTypes->search(
1096 { order_by => ['description'] }
1098 my $libraries = Koha::Libraries->search(
1100 { order_by => ['branchcode'] }
1102 my $biblio = $self->biblio;
1104 # Find all statistical patrons
1105 my $statistical_patrons = Koha::Patrons->search(
1106 { 'category_type' => 'x' },
1107 { join => { 'categorycode' => 'borrowers' } }
1110 if (!$params->{stage} || $params->{stage} eq 'init') {
1111 # Present a form to gather the required data
1113 # We may be viewing this page having previously tried to issue
1114 # the item (in which case, we may already have created an item)
1115 # so we pass the biblio for this request
1116 return {
1117 method => 'check_out',
1118 stage => 'form',
1119 value => {
1120 itemtypes => $itemtypes,
1121 libraries => $libraries,
1122 statistical => $statistical_patrons,
1123 biblio => $biblio
1126 } elsif ($params->{stage} eq 'form') {
1127 # Validate what we've got and return with an error if we fail
1128 my $errors = {};
1129 if (!$params->{item_type} || length $params->{item_type} == 0) {
1130 $errors->{item_type} = 1;
1132 if ($params->{inhouse} && length $params->{inhouse} > 0) {
1133 my $patron_count = Koha::Patrons->search({
1134 cardnumber => $params->{inhouse}
1135 })->count();
1136 if ($patron_count != 1) {
1137 $errors->{inhouse} = 1;
1141 # Check we don't have more than one item for this bib,
1142 # if we do, something very odd is going on
1143 # Having 1 is OK, it means we're likely trying to issue
1144 # following a previously failed attempt, the item exists
1145 # so we'll use it
1146 my @items = $biblio->items->as_list;
1147 my $item_count = scalar @items;
1148 if ($item_count > 1) {
1149 $errors->{itemcount} = 1;
1152 # Failed validation, go back to the form
1153 if (%{$errors}) {
1154 return {
1155 method => 'check_out',
1156 stage => 'form',
1157 value => {
1158 params => $params,
1159 statistical => $statistical_patrons,
1160 itemtypes => $itemtypes,
1161 libraries => $libraries,
1162 biblio => $biblio,
1163 errors => $errors
1168 # Passed validation
1170 # Create an item if one doesn't already exist,
1171 # if one does, use that
1172 my $itemnumber;
1173 if ($item_count == 0) {
1174 my $item_hash = {
1175 biblionumber => $self->biblio_id,
1176 homebranch => $params->{branchcode},
1177 holdingbranch => $params->{branchcode},
1178 location => $params->{branchcode},
1179 itype => $params->{item_type},
1180 barcode => 'ILL-' . $self->illrequest_id
1182 try {
1183 my $item = Koha::Item->new($item_hash)->store;
1184 $itemnumber = $item->itemnumber;
1186 } else {
1187 $itemnumber = $items[0]->itemnumber;
1189 # Check we have an item before going forward
1190 if (!$itemnumber) {
1191 return {
1192 method => 'check_out',
1193 stage => 'form',
1194 value => {
1195 params => $params,
1196 itemtypes => $itemtypes,
1197 libraries => $libraries,
1198 statistical => $statistical_patrons,
1199 errors => { item_creation => 1 }
1204 # Do the check out
1206 # Gather what we need
1207 my $target_item = Koha::Items->find( $itemnumber );
1208 # Determine who we're issuing to
1209 my $patron = $params->{inhouse} && length $params->{inhouse} > 0 ?
1210 Koha::Patrons->find({ cardnumber => $params->{inhouse} }) :
1211 $self->patron;
1213 my @issue_args = (
1214 $patron,
1215 scalar $target_item->barcode
1217 if ($params->{duedate} && length $params->{duedate} > 0) {
1218 push @issue_args, $params->{duedate};
1220 # Check if we can check out
1221 my ( $error, $confirm, $alerts, $messages ) =
1222 C4::Circulation::CanBookBeIssued(@issue_args);
1224 # If we got anything back saying we can't check out,
1225 # return it to the template
1226 my $problems = {};
1227 if ( $error && %{$error} ) { $problems->{error} = $error };
1228 if ( $confirm && %{$confirm} ) { $problems->{confirm} = $confirm };
1229 if ( $alerts && %{$alerts} ) { $problems->{alerts} = $alerts };
1230 if ( $messages && %{$messages} ) { $problems->{messages} = $messages };
1232 if (%{$problems}) {
1233 return {
1234 method => 'check_out',
1235 stage => 'form',
1236 value => {
1237 params => $params,
1238 itemtypes => $itemtypes,
1239 libraries => $libraries,
1240 statistical => $statistical_patrons,
1241 patron => $patron,
1242 biblio => $biblio,
1243 check_out_errors => $problems
1248 # We can allegedly check out, so make it so
1249 # For some reason, AddIssue requires an unblessed Patron
1250 $issue_args[0] = $patron->unblessed;
1251 my $issue = C4::Circulation::AddIssue(@issue_args);
1253 if ($issue) {
1254 # Update the request status
1255 $self->status('CHK')->store;
1256 return {
1257 method => 'check_out',
1258 stage => 'done_check_out',
1259 value => {
1260 params => $params,
1261 patron => $patron,
1262 check_out => $issue
1265 } else {
1266 return {
1267 method => 'check_out',
1268 stage => 'form',
1269 value => {
1270 params => $params,
1271 itemtypes => $itemtypes,
1272 libraries => $libraries,
1273 errors => { item_check_out => 1 }
1281 =head3 generic_confirm
1283 my $stage_summary = $illRequest->generic_confirm;
1285 Handle the generic_confirm extended method. The first stage involves creating
1286 a template email for the end user to edit in the browser. The second stage
1287 attempts to submit the email.
1289 =cut
1291 sub generic_confirm {
1292 my ( $self, $params ) = @_;
1293 my $branch = Koha::Libraries->find($params->{current_branchcode})
1294 || die "Invalid current branchcode. Are you logged in as the database user?";
1295 if ( !$params->{stage}|| $params->{stage} eq 'init' ) {
1296 # Get the message body from the notice definition
1297 my $letter = $self->get_notice({
1298 notice_code => 'ILL_PARTNER_REQ',
1299 transport => 'email'
1302 my $partners = Koha::Patrons->search({
1303 categorycode => $self->_config->partner_code
1305 return {
1306 error => 0,
1307 status => '',
1308 message => '',
1309 method => 'generic_confirm',
1310 stage => 'draft',
1311 value => {
1312 draft => {
1313 subject => $letter->{title},
1314 body => $letter->{content}
1316 partners => $partners,
1320 } elsif ( 'draft' eq $params->{stage} ) {
1321 # Create the to header
1322 my $to = $params->{partners};
1323 if ( defined $to ) {
1324 $to =~ s/^\x00//; # Strip leading NULLs
1325 $to =~ s/\x00/; /; # Replace others with '; '
1327 Koha::Exceptions::Ill::NoTargetEmail->throw(
1328 "No target email addresses found. Either select at least one partner or check your ILL partner library records.")
1329 if ( !$to );
1330 # Create the from, replyto and sender headers
1331 my $from = $branch->branchemail;
1332 my $replyto = $branch->inbound_ill_address;
1333 Koha::Exceptions::Ill::NoLibraryEmail->throw(
1334 "Your library has no usable email address. Please set it.")
1335 if ( !$from );
1337 # So we get a notice hashref, then substitute the possibly
1338 # modified title and body from the draft stage
1339 my $letter = $self->get_notice({
1340 notice_code => 'ILL_PARTNER_REQ',
1341 transport => 'email'
1343 $letter->{title} = $params->{subject};
1344 $letter->{content} = $params->{body};
1346 # Queue the notice
1347 my $params = {
1348 letter => $letter,
1349 borrowernumber => $self->borrowernumber,
1350 message_transport_type => 'email',
1351 to_address => $to,
1352 from_address => $from,
1353 reply_address => $replyto
1356 if ($letter) {
1357 my $result = C4::Letters::EnqueueLetter($params);
1358 if ( $result ) {
1359 $self->status("GENREQ")->store;
1360 $self->_backend_capability(
1361 'set_requested_partners',
1363 request => $self,
1364 to => $to
1367 return {
1368 error => 0,
1369 status => '',
1370 message => '',
1371 method => 'generic_confirm',
1372 stage => 'commit',
1373 next => 'illview',
1377 return {
1378 error => 1,
1379 status => 'email_failed',
1380 message => 'Email queueing failed',
1381 method => 'generic_confirm',
1382 stage => 'draft',
1384 } else {
1385 die "Unknown stage, should not have happened."
1389 =head3 send_patron_notice
1391 my $result = $request->send_patron_notice($notice_code);
1393 Send a specified notice regarding this request to a patron
1395 =cut
1397 sub send_patron_notice {
1398 my ( $self, $notice_code ) = @_;
1400 # We need a notice code
1401 if (!$notice_code) {
1402 return {
1403 error => 'notice_no_type'
1407 # Map from the notice code to the messaging preference
1408 my %message_name = (
1409 ILL_PICKUP_READY => 'Ill_ready',
1410 ILL_REQUEST_UNAVAIL => 'Ill_unavailable'
1413 # Get the patron's messaging preferences
1414 my $borrower_preferences = C4::Members::Messaging::GetMessagingPreferences({
1415 borrowernumber => $self->borrowernumber,
1416 message_name => $message_name{$notice_code}
1418 my @transports = keys %{ $borrower_preferences->{transports} };
1420 # Notice should come from the library where the request was placed,
1421 # not the patrons home library
1422 my $branch = Koha::Libraries->find($self->branchcode);
1423 my $from_address = $branch->branchemail;
1424 my $reply_address = $branch->inbound_ill_address;
1426 # Send the notice to the patron via the chosen transport methods
1427 # and record the results
1428 my @success = ();
1429 my @fail = ();
1430 for my $transport (@transports) {
1431 my $letter = $self->get_notice({
1432 notice_code => $notice_code,
1433 transport => $transport
1435 if ($letter) {
1436 my $result = C4::Letters::EnqueueLetter({
1437 letter => $letter,
1438 borrowernumber => $self->borrowernumber,
1439 message_transport_type => $transport,
1440 from_address => $from_address,
1441 reply_address => $reply_address
1443 if ($result) {
1444 push @success, $transport;
1445 } else {
1446 push @fail, $transport;
1448 } else {
1449 push @fail, $transport;
1452 if (scalar @success > 0) {
1453 my $logger = Koha::Illrequest::Logger->new;
1454 $logger->log_patron_notice({
1455 request => $self,
1456 notice_code => $notice_code
1459 return {
1460 result => {
1461 success => \@success,
1462 fail => \@fail
1467 =head3 send_staff_notice
1469 my $result = $request->send_staff_notice($notice_code);
1471 Send a specified notice regarding this request to staff
1473 =cut
1475 sub send_staff_notice {
1476 my ( $self, $notice_code ) = @_;
1478 # We need a notice code
1479 if (!$notice_code) {
1480 return {
1481 error => 'notice_no_type'
1485 # Get the staff notices that have been assigned for sending in
1486 # the syspref
1487 my $staff_to_send = C4::Context->preference('ILLSendStaffNotices') // q{};
1489 # If it hasn't been enabled in the syspref, we don't want to send it
1490 if ($staff_to_send !~ /\b$notice_code\b/) {
1491 return {
1492 error => 'notice_not_enabled'
1496 my $letter = $self->get_notice({
1497 notice_code => $notice_code,
1498 transport => 'email'
1501 # Try and get an address to which to send staff notices
1502 my $branch = Koha::Libraries->find($self->branchcode);
1503 my $to_address = $branch->inbound_ill_address;
1504 my $from_address = $branch->inbound_ill_address;
1506 my $params = {
1507 letter => $letter,
1508 borrowernumber => $self->borrowernumber,
1509 message_transport_type => 'email',
1510 from_address => $from_address
1513 if ($to_address) {
1514 $params->{to_address} = $to_address;
1515 } else {
1516 return {
1517 error => 'notice_no_create'
1521 if ($letter) {
1522 C4::Letters::EnqueueLetter($params)
1523 or warn "can't enqueue letter $letter";
1524 return {
1525 success => 'notice_queued'
1527 } else {
1528 return {
1529 error => 'notice_no_create'
1534 =head3 get_notice
1536 my $notice = $request->get_notice($params);
1538 Return a compiled notice hashref for the passed notice code
1539 and transport type
1541 =cut
1543 sub get_notice {
1544 my ( $self, $params ) = @_;
1546 my $title = $self->illrequestattributes->find(
1547 { type => 'title' }
1549 my $author = $self->illrequestattributes->find(
1550 { type => 'author' }
1552 my $metahash = $self->metadata;
1553 my @metaarray = ();
1554 while (my($key, $value) = each %{$metahash}) {
1555 push @metaarray, "- $key: $value" if $value;
1557 my $metastring = join("\n", @metaarray);
1558 my $letter = C4::Letters::GetPreparedLetter(
1559 module => 'ill',
1560 letter_code => $params->{notice_code},
1561 branchcode => $self->branchcode,
1562 message_transport_type => $params->{transport},
1563 lang => $self->patron->lang,
1564 tables => {
1565 illrequests => $self->illrequest_id,
1566 borrowers => $self->borrowernumber,
1567 biblio => $self->biblio_id,
1568 branches => $self->branchcode,
1570 substitute => {
1571 ill_bib_title => $title ? $title->value : '',
1572 ill_bib_author => $author ? $author->value : '',
1573 ill_full_metadata => $metastring
1577 return $letter;
1580 =head3 id_prefix
1582 my $prefix = $record->id_prefix;
1584 Return the prefix appropriate for the current Illrequest as derived from the
1585 borrower and branch associated with this request's Status, and the config
1586 file.
1588 =cut
1590 sub id_prefix {
1591 my ( $self ) = @_;
1592 my $prefix = $self->getPrefix( {
1593 branch => $self->branchcode,
1594 } );
1595 $prefix .= "-" if ( $prefix );
1596 return $prefix;
1599 =head3 _censor
1601 my $params = $illRequest->_censor($params);
1603 Return $params, modified to reflect our censorship requirements.
1605 =cut
1607 sub _censor {
1608 my ( $self, $params ) = @_;
1609 my $censorship = $self->_config->censorship;
1610 $params->{censor_notes_staff} = $censorship->{censor_notes_staff}
1611 if ( $params->{opac} );
1612 $params->{display_reply_date} = ( $censorship->{censor_reply_date} ) ? 0 : 1;
1614 return $params;
1617 =head3 store
1619 $Illrequest->store;
1621 Overloaded I<store> method that, in addition to performing the 'store',
1622 possibly records the fact that something happened
1624 =cut
1626 sub store {
1627 my ( $self, $attrs ) = @_;
1629 my $ret = $self->SUPER::store;
1631 $attrs->{log_origin} = 'core';
1633 if ($ret && defined $attrs) {
1634 my $logger = Koha::Illrequest::Logger->new;
1635 $logger->log_maybe({
1636 request => $self,
1637 attrs => $attrs
1641 return $ret;
1644 =head3 requested_partners
1646 my $partners_string = $illRequest->requested_partners;
1648 Return the string representing the email addresses of the partners to
1649 whom a request has been sent
1651 =cut
1653 sub requested_partners {
1654 my ( $self ) = @_;
1655 return $self->_backend_capability(
1656 'get_requested_partners',
1657 { request => $self }
1661 =head3 TO_JSON
1663 $json = $illrequest->TO_JSON
1665 Overloaded I<TO_JSON> method that takes care of inserting calculated values
1666 into the unblessed representation of the object.
1668 TODO: This method does nothing and is not called anywhere. However, bug 74325
1669 touches it, so keeping this for now until both this and bug 74325 are merged,
1670 at which point we can sort it out and remove it completely
1672 =cut
1674 sub TO_JSON {
1675 my ( $self, $embed ) = @_;
1677 my $object = $self->SUPER::TO_JSON();
1679 return $object;
1682 =head2 Internal methods
1684 =head3 _type
1686 =cut
1688 sub _type {
1689 return 'Illrequest';
1692 =head1 AUTHOR
1694 Alex Sassmannshausen <alex.sassmannshausen@ptfs-europe.com>
1695 Andrew Isherwood <andrew.isherwood@ptfs-europe.com>
1697 =cut