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>.
22 use Clone qw( clone );
23 use Try::Tiny qw( catch try );
27 use Mojo::Util qw(deprecated);
29 use Koha::Cache::Memory::Lite;
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;
39 use Koha::AuthorisedValues;
45 use C4::Circulation qw( CanBookBeIssued AddIssue );
47 use base qw(Koha::Object);
51 Koha::Illrequest - Koha Illrequest Object class
55 An ILLRequest consists of two parts; the Illrequest Koha::Object, and a series
56 of related Illrequestattributes.
58 The former encapsulates the basic necessary information that any ILL requires
59 to be usable in Koha. The latter is a set of additional properties used by
62 The former subsumes the legacy "Status" object. The latter remains
63 encapsulated in the "Record" object.
67 - Anything invoking the ->status method; annotated with:
68 + # Old use of ->status !
72 =head2 Backend API Response Principles
74 All methods should return a hashref in the following format:
80 This should be set to 1 if an error was encountered.
84 The status should be a string from the list of statuses detailed below.
88 The message is a free text field that can be passed on to the end user.
92 The value returned by the method.
96 =head2 Interface Status Messages
100 =item * branch_address_incomplete
102 An interface request has determined branch address details are incomplete.
104 =item * cancel_success
106 The interface's cancel_request method was successful in cancelling the
107 Illrequest using the API.
111 The interface's cancel_request method failed to cancel the Illrequest using
116 The interface's request method returned saying that the desired item is not
117 available for request.
123 =head3 init_processors
125 $request->init_processors()
127 Initialises an empty processors arrayref
131 sub init_processors {
134 $self->{processors} = [];
137 =head3 push_processor
139 $request->push_processors(sub { ...something... });
141 Pushes a passed processor function into our processors arrayref
146 my ( $self, $processor ) = @_;
147 push @{$self->{processors}}, $processor;
152 my $ill_batch = $request->ill_batch;
154 Returns the I<Koha::Illbatch> associated with the request
161 my $ill_batch = $self->_result->ill_batch;
162 return unless $ill_batch;
163 return Koha::Illbatch->_new_from_dbic($ill_batch);
168 my $statusalias = $request->statusalias;
170 Returns a request's status alias, as a Koha::AuthorisedValue instance
171 or implicit undef. This is distinct from status_alias, which only returns
172 the value in the status_alias column, this method returns the entire
173 AuthorisedValue object
179 return unless $self->status_alias;
180 # We can't know which result is the right one if there are multiple
181 # ILL_STATUS_ALIAS authorised values with the same authorised_value column value
182 # so we just use the first
183 return Koha::AuthorisedValues->search(
185 category => 'ILL_STATUS_ALIAS',
186 authorised_value => $self->SUPER::status_alias
193 =head3 illrequestattributes
197 sub illrequestattributes {
198 deprecated 'illrequestattributes is DEPRECATED in favor of extended_attributes';
200 return Koha::Illrequestattributes->_new_from_dbic(
201 scalar $self->_result->illrequestattributes
211 return Koha::Illcomments->_new_from_dbic(
212 scalar $self->_result->illcomments
218 my $ill_comments = $req->comments;
220 Returns a I<Koha::Illcomments> resultset for the linked comments.
226 return Koha::Illcomments->_new_from_dbic(
227 scalar $self->_result->comments
237 my $logger = Koha::Illrequest::Logger->new;
238 return $logger->get_request_logs($self);
243 my $patron = $request->patron;
245 For a given request, return the linked I<Koha::Patron> object
246 associated with it, or undef if none exists
253 my $patron_rs = $self->_result->patron;
254 return unless $patron_rs;
255 return Koha::Patron->_new_from_dbic($patron_rs);
260 my $library = $request->library;
262 Returns the linked I<Koha::Library> object.
269 return Koha::Library->_new_from_dbic( scalar $self->_result->library );
272 =head3 extended_attributes
274 my $extended_attributes = $request->extended_attributes;
276 Returns the linked I<Koha::Illrequestattributes> resultset object.
280 sub extended_attributes {
283 my $rs = $self->_result->extended_attributes;
284 # We call search to use the filters in Koha::Illrequestattributes->search
285 return Koha::Illrequestattributes->_new_from_dbic($rs)->search;
290 $Illrequest->status_alias(143);
292 Overloaded getter/setter for status_alias,
293 that only returns authorised values from the
294 correct category and records the fact that the status has changed
299 my ($self, $new_status_alias) = @_;
301 my $current_status_alias = $self->SUPER::status_alias;
303 if ($new_status_alias) {
304 # Keep a record of the previous status before we change it,
306 $self->{previous_status} = $current_status_alias ?
307 $current_status_alias :
308 scalar $self->status;
309 # This is hackery to enable us to undefine
310 # status_alias, since we need to have an overloaded
311 # status_alias method to get us around the problem described
313 # https://bugs.koha-community.org/bugzilla3/show_bug.cgi?id=20581#c156
314 # We need a way of accepting implied undef, so we can nullify
315 # the status_alias column, when called from $self->status
316 my $val = $new_status_alias eq "-1" ? undef : $new_status_alias;
317 my $ret = $self->SUPER::status_alias($val);
318 my $val_to_log = $val ? $new_status_alias : scalar $self->status;
320 my $logger = Koha::Illrequest::Logger->new;
321 $logger->log_status_change({
326 delete $self->{previous_status};
330 # We can't know which result is the right one if there are multiple
331 # ILL_STATUS_ALIAS authorised values with the same authorised_value column value
332 # so we just use the first
333 my $alias = Koha::AuthorisedValues->search(
335 category => 'ILL_STATUS_ALIAS',
336 authorised_value => $self->SUPER::status_alias
343 return $alias->authorised_value;
351 $Illrequest->status('CANREQ');
353 Overloaded getter/setter for request status,
354 also nullifies status_alias and records the fact that the status has changed
355 and sends a notice if appropriate
360 my ( $self, $new_status) = @_;
362 my $current_status = $self->SUPER::status;
363 my $current_status_alias = $self->SUPER::status_alias;
366 # Keep a record of the previous status before we change it,
368 $self->{previous_status} = $current_status_alias ?
369 $current_status_alias :
371 my $ret = $self->SUPER::status($new_status)->store;
372 if ($current_status_alias) {
373 # This is hackery to enable us to undefine
374 # status_alias, since we need to have an overloaded
375 # status_alias method to get us around the problem described
377 # https://bugs.koha-community.org/bugzilla3/show_bug.cgi?id=20581#c156
378 # We need a way of passing implied undef to nullify status_alias
379 # so we pass -1, which is special cased in the overloaded setter
380 $self->status_alias("-1");
382 my $logger = Koha::Illrequest::Logger->new;
383 $logger->log_status_change({
388 delete $self->{previous_status};
389 # If status has changed to cancellation requested, send a notice
390 if ($new_status eq 'CANCREQ') {
391 $self->send_staff_notice('ILL_REQUEST_CANCEL');
395 return $current_status;
401 Require "Base.pm" from the relevant ILL backend.
406 my ( $self, $backend_id ) = @_;
408 my @raw = qw/Koha Illbackends/; # Base Path
410 my $backend_name = $backend_id || $self->backend;
412 unless ( defined $backend_name && $backend_name ne '' ) {
413 Koha::Exceptions::Ill::InvalidBackendId->throw(
414 "An invalid backend ID was requested ('')");
417 my $location = join "/", @raw, $backend_name, "Base.pm"; # File to load
418 my $backend_class = join "::", @raw, $backend_name, "Base"; # Package name
420 $self->{_my_backend} = $backend_class->new({
421 config => $self->_config,
422 logger => Koha::Illrequest::Logger->new
430 my $backend = $abstract->_backend($new_backend);
431 my $backend = $abstract->_backend;
433 Getter/Setter for our API object.
438 my ( $self, $backend ) = @_;
439 $self->{_my_backend} = $backend if ( $backend );
440 # Dynamically load our backend object, as late as possible.
441 $self->load_backend unless ( $self->{_my_backend} );
442 return $self->{_my_backend};
445 =head3 _backend_capability
447 my $backend_capability_result = $self->_backend_capability($name, $args);
449 This is a helper method to invoke optional capabilities in the backend. If
450 the capability named by $name is not supported, return 0, else invoke it,
451 passing $args along with the invocation, and return its return value.
453 NOTE: this module suffers from a confusion in termninology:
455 in _backend_capability, the notion of capability refers to an optional feature
456 that is implemented in core, but might not be supported by a given backend.
458 in capabilities & custom_capability, capability refers to entries in the
459 status_graph (after union between backend and core).
461 The easiest way to fix this would be to fix the terminology in
462 capabilities & custom_capability and their callers.
466 sub _backend_capability {
467 my ( $self, $name, $args ) = @_;
469 # See if capability is defined in backend
471 $capability = $self->_backend->capabilities($name);
477 if ( $capability && ref($capability) eq 'CODE' ) {
478 return &{$capability}($args);
486 my $config = $abstract->_config($config);
487 my $config = $abstract->_config;
489 Getter/Setter for our config object.
494 my ( $self, $config ) = @_;
495 $self->{_my_config} = $config if ( $config );
496 # Load our config object, as late as possible.
497 unless ( $self->{_my_config} ) {
498 $self->{_my_config} = Koha::Illrequest::Config->new;
500 return $self->{_my_config};
509 return $self->_backend->metadata($self);
512 =head3 _core_status_graph
514 my $core_status_graph = $illrequest->_core_status_graph;
516 Returns ILL module's default status graph. A status graph defines the list of
517 available actions at any stage in the ILL workflow. This is for instance used
518 by the perl script & template to generate the correct buttons to display to
519 the end user at any given point.
523 sub _core_status_graph {
527 prev_actions => [ ], # Actions containing buttons
528 # leading to this status
529 id => 'NEW', # ID of this status
530 name => 'New request', # UI name of this status
531 ui_method_name => 'New request', # UI name of method leading
533 method => 'create', # method to this status
534 next_actions => [ 'REQ', 'GENREQ', 'KILL' ], # buttons to add to all
535 # requests with this status
536 ui_method_icon => 'fa-plus', # UI Style class
539 prev_actions => [ 'NEW', 'REQREV', 'QUEUED', 'CANCREQ' ],
542 ui_method_name => 'Confirm request',
544 next_actions => [ 'REQREV', 'COMP', 'CHK' ],
545 ui_method_icon => 'fa-check',
548 prev_actions => [ 'NEW', 'REQREV' ],
550 name => 'Requested from partners',
551 ui_method_name => 'Place request with partners',
552 method => 'generic_confirm',
553 next_actions => [ 'COMP', 'CHK', 'REQREV' ],
554 ui_method_icon => 'fa-paper-plane',
557 prev_actions => [ 'REQ', 'GENREQ' ],
559 name => 'Request reverted',
560 ui_method_name => 'Revert request',
562 next_actions => [ 'REQ', 'GENREQ', 'KILL' ],
563 ui_method_icon => 'fa-times',
568 name => 'Queued request',
571 next_actions => [ 'REQ', 'KILL' ],
575 prev_actions => [ 'NEW' ],
577 name => 'Cancellation requested',
580 next_actions => [ 'KILL', 'REQ' ],
584 prev_actions => [ 'REQ' ],
587 ui_method_name => 'Mark completed',
588 method => 'mark_completed',
589 next_actions => [ 'CHK' ],
590 ui_method_icon => 'fa-check',
593 prev_actions => [ 'QUEUED', 'REQREV', 'NEW', 'CANCREQ' ],
596 ui_method_name => 'Delete request',
599 ui_method_icon => 'fa-trash',
602 prev_actions => [ 'REQ', 'GENREQ', 'COMP' ],
604 name => 'Checked out',
605 ui_method_name => 'Check out',
606 needs_prefs => [ 'CirculateILL' ],
607 needs_perms => [ 'user_circulate_circulate_remaining_permissions' ],
608 # An array of functions that all must return true
609 needs_all => [ sub { my $r = shift; return $r->biblio; } ],
610 method => 'check_out',
612 ui_method_icon => 'fa-upload',
615 prev_actions => [ 'CHK' ],
617 name => 'Returned to library',
618 ui_method_name => 'Check in',
619 method => 'check_in',
620 next_actions => [ 'COMP' ],
621 ui_method_icon => 'fa-download',
626 =head3 _status_graph_union
628 my $status_graph = $illrequest->_status_graph_union($origin, $new_graph);
630 Return a new status_graph, the result of merging $origin & new_graph. This is
631 operation is a union over the sets defied by the two graphs.
633 Each entry in $new_graph is added to $origin. We do not provide a syntax for
634 'subtraction' of entries from $origin.
636 Whilst it is not intended that this works, you can override entries in $origin
637 with entries with the same key in $new_graph. This can lead to problematic
638 behaviour when $new_graph adds an entry, which modifies a dependent entry in
639 $origin, only for the entry in $origin to be replaced later with a new entry
642 NOTE: this procedure does not "re-link" entries in $origin or $new_graph,
643 i.e. each of the graphs need to be correct at the outset of the operation.
647 sub _status_graph_union {
648 my ( $self, $core_status_graph, $backend_status_graph ) = @_;
649 # Create new status graph with:
650 # - all core_status_graph
651 # - for-each each backend_status_graph
652 # + add to new status graph
653 # + for each core prev_action:
654 # * locate core_status
655 # * update next_actions with additional next action.
656 # + for each core next_action:
657 # * locate core_status
658 # * update prev_actions with additional prev action
660 my @core_status_ids = keys %{$core_status_graph};
661 my $status_graph = clone($core_status_graph);
663 foreach my $backend_status_key ( keys %{$backend_status_graph} ) {
664 my $backend_status = $backend_status_graph->{$backend_status_key};
665 # Add to new status graph
666 $status_graph->{$backend_status_key} = $backend_status;
667 # Update all core methods' next_actions.
668 foreach my $prev_action ( @{$backend_status->{prev_actions}} ) {
669 if ( grep { $prev_action eq $_ } @core_status_ids ) {
671 @{$status_graph->{$prev_action}->{next_actions}};
672 push @next_actions, $backend_status_key
673 if (!grep(/^$backend_status_key$/, @next_actions));
674 $status_graph->{$prev_action}->{next_actions}
678 # Update all core methods' prev_actions
679 foreach my $next_action ( @{$backend_status->{next_actions}} ) {
680 if ( grep { $next_action eq $_ } @core_status_ids ) {
682 @{$status_graph->{$next_action}->{prev_actions}};
683 push @prev_actions, $backend_status_key
684 if (!grep(/^$backend_status_key$/, @prev_actions));
685 $status_graph->{$next_action}->{prev_actions}
691 return $status_graph;
698 my $capabilities = $illrequest->capabilities;
700 Return a hashref mapping methods to operation names supported by the queried
703 Example return value:
705 { create => "Create Request", confirm => "Progress Request" }
707 NOTE: this module suffers from a confusion in termninology:
709 in _backend_capability, the notion of capability refers to an optional feature
710 that is implemented in core, but might not be supported by a given backend.
712 in capabilities & custom_capability, capability refers to entries in the
713 status_graph (after union between backend and core).
715 The easiest way to fix this would be to fix the terminology in
716 capabilities & custom_capability and their callers.
721 my ( $self, $status ) = @_;
722 # Generate up to date status_graph
723 my $status_graph = $self->_status_graph_union(
724 $self->_core_status_graph,
725 $self->_backend->status_graph({
730 # Extract available actions from graph.
731 return $status_graph->{$status} if $status;
732 # Or return entire graph.
733 return $status_graph;
736 =head3 custom_capability
738 Return the result of invoking $CANDIDATE on this request's backend with
739 $PARAMS, or 0 if $CANDIDATE is an unknown method on backend.
741 NOTE: this module suffers from a confusion in termninology:
743 in _backend_capability, the notion of capability refers to an optional feature
744 that is implemented in core, but might not be supported by a given backend.
746 in capabilities & custom_capability, capability refers to entries in the
747 status_graph (after union between backend and core).
749 The easiest way to fix this would be to fix the terminology in
750 capabilities & custom_capability and their callers.
754 sub custom_capability {
755 my ( $self, $candidate, $params ) = @_;
756 foreach my $capability ( values %{$self->capabilities} ) {
757 if ( $candidate eq $capability->{method} ) {
759 $self->_backend->$candidate({
763 return $self->expandTemplate($response);
769 =head3 available_backends
771 Return a list of available backends.
775 sub available_backends {
776 my ( $self, $reduced ) = @_;
777 my $backends = $self->_config->available_backends($reduced);
781 =head3 available_actions
783 Return a list of available actions.
787 sub available_actions {
789 my $current_action = $self->capabilities($self->status);
790 my @available_actions = map { $self->capabilities($_) }
791 @{$current_action->{next_actions}};
792 return \@available_actions;
795 =head3 mark_completed
797 Mark a request as completed (status = COMP).
803 $self->status('COMP')->store;
804 $self->completed(dt_from_string())->store;
809 method => 'mark_completed',
815 =head2 backend_illview
817 View and manage an ILL request
821 sub backend_illview {
822 my ( $self, $params ) = @_;
824 my $response = $self->_backend_capability('illview',{
828 return $self->expandTemplate($response) if $response;
832 =head2 backend_migrate
834 Migrate a request from one backend to another.
838 sub backend_migrate {
839 my ( $self, $params ) = @_;
840 # Set the request's backend to be the destination backend
841 $self->load_backend($params->{backend});
842 my $response = $self->_backend_capability('migrate',{
846 return $self->expandTemplate($response) if $response;
850 =head2 backend_confirm
852 Confirm a request. The backend handles setting of mandatory fields in the commit stage:
858 =item * accessurl, cost (if available).
864 sub backend_confirm {
865 my ( $self, $params ) = @_;
867 my $response = $self->_backend->confirm({
871 return $self->expandTemplate($response);
874 =head3 backend_update_status
878 sub backend_update_status {
879 my ( $self, $params ) = @_;
880 return $self->expandTemplate($self->_backend->update_status($params));
883 =head3 backend_cancel
885 my $ILLResponse = $illRequest->backend_cancel;
887 The standard interface method allowing for request cancellation.
892 my ( $self, $params ) = @_;
894 my $result = $self->_backend->cancel({
899 return $self->expandTemplate($result);
904 my $renew_response = $illRequest->backend_renew;
906 The standard interface method allowing for request renewal queries.
912 return $self->expandTemplate(
913 $self->_backend->renew({
919 =head3 backend_create
921 my $create_response = $abstractILL->backend_create($params);
923 Return an array of Record objects created by querying our backend with
926 In the context of the other ILL methods, this is a special method: we only
927 pass it $params, as it does not yet have any other data associated with it.
932 my ( $self, $params ) = @_;
934 # Establish whether we need to do a generic copyright clearance.
935 if ($params->{opac}) {
936 if ( ( !$params->{stage} || $params->{stage} eq 'init' )
937 && C4::Context->preference("ILLModuleCopyrightClearance") ) {
943 stage => 'copyrightclearance',
946 backend => $self->_backend->name
949 } elsif ( defined $params->{stage}
950 && $params->{stage} eq 'copyrightclearance' ) {
951 $params->{stage} = 'init';
954 # First perform API action, then...
959 my $result = $self->_backend->create($args);
961 # ... simple case: we're not at 'commit' stage.
962 my $stage = $result->{stage};
963 return $self->expandTemplate($result)
964 unless ( 'commit' eq $stage );
966 # ... complex case: commit!
968 # Do we still have space for an ILL or should we queue?
969 my $permitted = $self->check_limits(
970 { patron => $self->patron }, { librarycode => $self->branchcode }
973 # Now augment our committed request.
975 $result->{permitted} = $permitted; # Queue request?
979 # ...Updating status!
980 $self->status('QUEUED')->store unless ( $permitted );
982 ## Handle Unmediated ILLs
984 # For the unmediated workflow we only need to delegate to our backend. If
985 # that backend supports unmediateld_ill, it will do its thing and return a
986 # proper response. If it doesn't then _backend_capability returns 0, so
987 # we keep the current result.
988 if ( C4::Context->preference("ILLModuleUnmediated") && $permitted ) {
989 my $unmediated_result = $self->_backend_capability(
993 $result = $unmediated_result if $unmediated_result;
996 return $self->expandTemplate($result);
999 =head3 backend_get_update
1001 my $update = backend_get_update($request);
1003 Given a request, returns an update in a prescribed
1004 format that can then be passed to update parsers
1008 sub backend_get_update {
1009 my ( $self, $options ) = @_;
1011 my $response = $self->_backend_capability(
1012 'get_supplier_update',
1021 =head3 expandTemplate
1023 my $params = $abstract->expandTemplate($params);
1025 Return a version of $PARAMS augmented with our required template path.
1029 sub expandTemplate {
1030 my ( $self, $params ) = @_;
1031 my $backend = $self->_backend->name;
1032 # Generate path to file to load
1033 my $backend_dir = $self->_config->backend_dir;
1034 my $backend_tmpl = join "/", $backend_dir, $backend;
1035 my $intra_tmpl = join "/", $backend_tmpl, "intra-includes",
1036 ( $params->{method}//q{} ) . ".inc";
1037 my $opac_tmpl = join "/", $backend_tmpl, "opac-includes",
1038 ( $params->{method}//q{} ) . ".inc";
1040 $params->{template} = $intra_tmpl;
1041 $params->{opac_template} = $opac_tmpl;
1045 #### Abstract Imports
1049 my $limit_rules = $abstract->getLimits( {
1050 type => 'brw_cat' | 'branch',
1054 Return the ILL limit rules for the supplied combination of type / value.
1056 As the config may have no rules for this particular type / value combination,
1057 or for the default, we must define fall-back values here.
1062 my ( $self, $params ) = @_;
1063 my $limits = $self->_config->getLimitRules($params->{type});
1065 if ( defined $params->{value}
1066 && defined $limits->{$params->{value}} ) {
1067 return $limits->{$params->{value}};
1070 return $limits->{default} || { count => -1, method => 'active' };
1076 my $prefix = $abstract->getPrefix( {
1077 branch => $branch_code
1080 Return the ILL prefix as defined by our $params: either per borrower category,
1081 per branch or the default.
1086 my ( $self, $params ) = @_;
1087 my $brn_prefixes = $self->_config->getPrefixes();
1088 return $brn_prefixes->{$params->{branch}} || ""; # "the empty prefix"
1093 my $type = $abstract->get_type();
1095 Return a string representing the material type of this request or undef
1101 my $attr = $self->illrequestattributes->find({ type => 'type'});
1103 return $attr->value;
1106 #### Illrequests Imports
1110 my $ok = $illRequests->check_limits( {
1111 borrower => $borrower,
1112 branchcode => 'branchcode' | undef,
1115 Given $PARAMS, a hashref containing a $borrower object and a $branchcode,
1116 see whether we are still able to place ILLs.
1118 LimitRules are derived from koha-conf.xml:
1119 + default limit counts, and counting method
1120 + branch specific limit counts & counting method
1121 + borrower category specific limit counts & counting method
1122 + err on the side of caution: a counting fail will cause fail, even if
1123 the other counts passes.
1128 my ( $self, $params ) = @_;
1129 my $patron = $params->{patron};
1130 my $branchcode = $params->{librarycode} || $patron->branchcode;
1132 # Establish maximum number of allowed requests
1133 my ( $branch_rules, $brw_rules ) = (
1136 value => $branchcode
1140 value => $patron->categorycode,
1143 my ( $branch_limit, $brw_limit )
1144 = ( $branch_rules->{count}, $brw_rules->{count} );
1145 # Establish currently existing requests
1146 my ( $branch_count, $brw_count ) = (
1147 $self->_limit_counter(
1148 $branch_rules->{method}, { branchcode => $branchcode }
1150 $self->_limit_counter(
1151 $brw_rules->{method}, { borrowernumber => $patron->borrowernumber }
1155 # Compare and return
1156 # A limit of -1 means no limit exists.
1157 # We return blocked if either branch limit or brw limit is reached.
1158 if ( ( $branch_limit != -1 && $branch_limit <= $branch_count )
1159 || ( $brw_limit != -1 && $brw_limit <= $brw_count ) ) {
1166 sub _limit_counter {
1167 my ( $self, $method, $target ) = @_;
1169 # Establish parameters of counts
1171 if ($method && $method eq 'annual') {
1172 $resultset = Koha::Illrequests->search({
1175 \"YEAR(placed) = YEAR(NOW())"
1178 } else { # assume 'active'
1179 # XXX: This status list is ugly. There should be a method in config
1181 my $where = { status => { -not_in => [ 'QUEUED', 'COMP' ] } };
1182 $resultset = Koha::Illrequests->search({ %{$target}, %{$where} });
1186 return $resultset->count;
1189 =head3 requires_moderation
1191 my $status = $illRequest->requires_moderation;
1193 Return the name of the status if moderation by staff is required; or 0
1198 sub requires_moderation {
1200 my $require_moderation = {
1201 'CANCREQ' => 'CANCREQ',
1203 return $require_moderation->{$self->status};
1208 my $biblio = $request->biblio;
1210 For a given request, return the biblio associated with it,
1211 or undef if none exists
1217 my $biblio_rs = $self->_result->biblio;
1218 return unless $biblio_rs;
1219 return Koha::Biblio->_new_from_dbic($biblio_rs);
1224 my $stage_summary = $request->check_out;
1226 Handle the check_out method. The first stage involves gathering the required
1227 data from the user via a form, the second stage creates an item and tries to
1228 issue it to the patron. If successful, it notifies the patron, then it
1229 returns a summary of how things went
1234 my ( $self, $params ) = @_;
1236 # Objects required by the template
1237 my $itemtypes = Koha::ItemTypes->search(
1239 { order_by => ['description'] }
1241 my $libraries = Koha::Libraries->search(
1243 { order_by => ['branchcode'] }
1245 my $biblio = $self->biblio;
1247 # Find all statistical patrons
1248 my $statistical_patrons = Koha::Patrons->search(
1249 { 'category_type' => 'x' },
1250 { join => { 'categorycode' => 'borrowers' } }
1253 if (!$params->{stage} || $params->{stage} eq 'init') {
1254 # Present a form to gather the required data
1256 # We may be viewing this page having previously tried to issue
1257 # the item (in which case, we may already have created an item)
1258 # so we pass the biblio for this request
1260 method => 'check_out',
1263 itemtypes => $itemtypes,
1264 libraries => $libraries,
1265 statistical => $statistical_patrons,
1269 } elsif ($params->{stage} eq 'form') {
1270 # Validate what we've got and return with an error if we fail
1272 if (!$params->{item_type} || length $params->{item_type} == 0) {
1273 $errors->{item_type} = 1;
1275 if ($params->{inhouse} && length $params->{inhouse} > 0) {
1276 my $patron_count = Koha::Patrons->search({
1277 cardnumber => $params->{inhouse}
1279 if ($patron_count != 1) {
1280 $errors->{inhouse} = 1;
1284 # Check we don't have more than one item for this bib,
1285 # if we do, something very odd is going on
1286 # Having 1 is OK, it means we're likely trying to issue
1287 # following a previously failed attempt, the item exists
1289 my @items = $biblio->items->as_list;
1290 my $item_count = scalar @items;
1291 if ($item_count > 1) {
1292 $errors->{itemcount} = 1;
1295 # Failed validation, go back to the form
1298 method => 'check_out',
1302 statistical => $statistical_patrons,
1303 itemtypes => $itemtypes,
1304 libraries => $libraries,
1313 # Create an item if one doesn't already exist,
1314 # if one does, use that
1316 if ($item_count == 0) {
1318 biblionumber => $self->biblio_id,
1319 homebranch => $params->{branchcode},
1320 holdingbranch => $params->{branchcode},
1321 location => $params->{branchcode},
1322 itype => $params->{item_type},
1323 barcode => 'ILL-' . $self->illrequest_id
1326 my $item = Koha::Item->new($item_hash)->store;
1327 $itemnumber = $item->itemnumber;
1330 $itemnumber = $items[0]->itemnumber;
1332 # Check we have an item before going forward
1335 method => 'check_out',
1339 itemtypes => $itemtypes,
1340 libraries => $libraries,
1341 statistical => $statistical_patrons,
1342 errors => { item_creation => 1 }
1349 # Gather what we need
1350 my $target_item = Koha::Items->find( $itemnumber );
1351 # Determine who we're issuing to
1352 my $patron = $params->{inhouse} && length $params->{inhouse} > 0 ?
1353 Koha::Patrons->find({ cardnumber => $params->{inhouse} }) :
1358 scalar $target_item->barcode
1360 if ($params->{duedate} && length $params->{duedate} > 0) {
1361 push @issue_args, dt_from_string($params->{duedate});
1363 # Check if we can check out
1364 my ( $error, $confirm, $alerts, $messages ) =
1365 C4::Circulation::CanBookBeIssued(@issue_args);
1367 # If we got anything back saying we can't check out,
1368 # return it to the template
1370 if ( $error && %{$error} ) { $problems->{error} = $error };
1371 if ( $confirm && %{$confirm} ) { $problems->{confirm} = $confirm };
1372 if ( $alerts && %{$alerts} ) { $problems->{alerts} = $alerts };
1373 if ( $messages && %{$messages} ) { $problems->{messages} = $messages };
1377 method => 'check_out',
1381 itemtypes => $itemtypes,
1382 libraries => $libraries,
1383 statistical => $statistical_patrons,
1386 check_out_errors => $problems
1391 # We can allegedly check out, so make it so
1392 my $issue = C4::Circulation::AddIssue(@issue_args);
1395 # Update the request status
1396 $self->status('CHK')->store;
1398 method => 'check_out',
1399 stage => 'done_check_out',
1408 method => 'check_out',
1412 itemtypes => $itemtypes,
1413 libraries => $libraries,
1414 errors => { item_check_out => 1 }
1422 =head3 generic_confirm
1424 my $stage_summary = $illRequest->generic_confirm;
1426 Handle the generic_confirm extended method. The first stage involves creating
1427 a template email for the end user to edit in the browser. The second stage
1428 attempts to submit the email.
1432 sub generic_confirm {
1433 my ( $self, $params ) = @_;
1434 my $branch = Koha::Libraries->find($params->{current_branchcode})
1435 || die "Invalid current branchcode. Are you logged in as the database user?";
1436 if ( !$params->{stage}|| $params->{stage} eq 'init' ) {
1437 # Get the message body from the notice definition
1438 my $letter = $self->get_notice({
1439 notice_code => 'ILL_PARTNER_REQ',
1440 transport => 'email'
1443 my $partners = Koha::Patrons->search({
1444 categorycode => $self->_config->partner_code
1450 method => 'generic_confirm',
1454 subject => $letter->{title},
1455 body => $letter->{content}
1457 partners => $partners,
1461 } elsif ( 'draft' eq $params->{stage} ) {
1462 # Create the to header
1463 my $to = $params->{partners};
1464 if ( defined $to ) {
1465 $to =~ s/^\x00//; # Strip leading NULLs
1467 Koha::Exceptions::Ill::NoTargetEmail->throw(
1468 "No target email addresses found. Either select at least one partner or check your ILL partner library records.")
1471 # Take the null delimited string that we receive and create
1472 # an array of associated patron objects
1473 my @to_patrons = map {
1474 Koha::Patrons->find({ borrowernumber => $_ })
1475 } split(/\x00/, $to);
1477 # Create the from, replyto and sender headers
1478 my $from = $branch->from_email_address;
1479 my $replyto = $branch->inbound_ill_address;
1480 Koha::Exceptions::Ill::NoLibraryEmail->throw(
1481 "Your library has no usable email address. Please set it.")
1484 # So we get a notice hashref, then substitute the possibly
1485 # modified title and body from the draft stage
1486 my $letter = $self->get_notice({
1487 notice_code => 'ILL_PARTNER_REQ',
1488 transport => 'email'
1490 $letter->{title} = $params->{subject};
1491 $letter->{content} = $params->{body};
1495 # Keep track of who received this notice
1497 # Iterate our array of recipient patron objects
1498 foreach my $patron(@to_patrons) {
1499 # Create the params we pass to the notice
1502 borrowernumber => $patron->borrowernumber,
1503 message_transport_type => 'email',
1504 to_address => $patron->email,
1505 from_address => $from,
1506 reply_address => $replyto
1508 my $result = C4::Letters::EnqueueLetter($params);
1510 push @queued, $patron->email;
1514 # If all notices were queued successfully,
1516 if (scalar @queued == scalar @to_patrons) {
1517 $self->status("GENREQ")->store;
1518 $self->_backend_capability(
1519 'set_requested_partners',
1522 to => join("; ", @queued)
1529 method => 'generic_confirm',
1538 status => 'email_failed',
1539 message => 'Email queueing failed',
1540 method => 'generic_confirm',
1544 die "Unknown stage, should not have happened."
1548 =head3 send_patron_notice
1550 my $result = $request->send_patron_notice($notice_code);
1552 Send a specified notice regarding this request to a patron
1556 sub send_patron_notice {
1557 my ( $self, $notice_code, $additional_text ) = @_;
1559 # We need a notice code
1560 if (!$notice_code) {
1562 error => 'notice_no_type'
1566 # Map from the notice code to the messaging preference
1567 my %message_name = (
1568 ILL_PICKUP_READY => 'Ill_ready',
1569 ILL_REQUEST_UNAVAIL => 'Ill_unavailable',
1570 ILL_REQUEST_UPDATE => 'Ill_update'
1573 # Get the patron's messaging preferences
1574 my $borrower_preferences = C4::Members::Messaging::GetMessagingPreferences({
1575 borrowernumber => $self->borrowernumber,
1576 message_name => $message_name{$notice_code}
1578 my @transports = keys %{ $borrower_preferences->{transports} };
1580 # Notice should come from the library where the request was placed,
1581 # not the patrons home library
1582 my $branch = Koha::Libraries->find($self->branchcode);
1583 my $from_address = $branch->from_email_address;
1584 my $reply_address = $branch->inbound_ill_address;
1586 # Send the notice to the patron via the chosen transport methods
1587 # and record the results
1590 for my $transport (@transports) {
1591 my $letter = $self->get_notice({
1592 notice_code => $notice_code,
1593 transport => $transport,
1594 additional_text => $additional_text
1597 my $result = C4::Letters::EnqueueLetter({
1599 borrowernumber => $self->borrowernumber,
1600 message_transport_type => $transport,
1601 from_address => $from_address,
1602 reply_address => $reply_address
1605 push @success, $transport;
1607 push @fail, $transport;
1610 push @fail, $transport;
1613 if (scalar @success > 0) {
1614 my $logger = Koha::Illrequest::Logger->new;
1615 $logger->log_patron_notice({
1617 notice_code => $notice_code
1622 success => \@success,
1628 =head3 send_staff_notice
1630 my $result = $request->send_staff_notice($notice_code);
1632 Send a specified notice regarding this request to staff
1636 sub send_staff_notice {
1637 my ( $self, $notice_code ) = @_;
1639 # We need a notice code
1640 if (!$notice_code) {
1642 error => 'notice_no_type'
1646 # Get the staff notices that have been assigned for sending in
1648 my $staff_to_send = C4::Context->preference('ILLSendStaffNotices') // q{};
1650 # If it hasn't been enabled in the syspref, we don't want to send it
1651 if ($staff_to_send !~ /\b$notice_code\b/) {
1653 error => 'notice_not_enabled'
1657 my $letter = $self->get_notice({
1658 notice_code => $notice_code,
1659 transport => 'email'
1662 # Try and get an address to which to send staff notices
1663 my $branch = Koha::Libraries->find($self->branchcode);
1664 my $to_address = $branch->inbound_ill_address;
1665 my $from_address = $branch->inbound_ill_address;
1669 borrowernumber => $self->borrowernumber,
1670 message_transport_type => 'email',
1671 from_address => $from_address
1675 $params->{to_address} = $to_address;
1678 error => 'notice_no_create'
1683 C4::Letters::EnqueueLetter($params)
1684 or warn "can't enqueue letter $letter";
1686 success => 'notice_queued'
1690 error => 'notice_no_create'
1697 my $notice = $request->get_notice($params);
1699 Return a compiled notice hashref for the passed notice code
1705 my ( $self, $params ) = @_;
1707 my $title = $self->illrequestattributes->find(
1710 my $author = $self->illrequestattributes->find(
1711 { type => 'author' }
1713 my $metahash = $self->metadata;
1715 foreach my $key (sort { lc $a cmp lc $b } keys %{$metahash}) {
1716 my $value = $metahash->{$key};
1717 push @metaarray, "- $key: $value" if $value;
1719 my $metastring = join("\n", @metaarray);
1721 my $illrequestattributes = {
1722 map { $_->type => $_->value } $self->illrequestattributes->as_list
1725 my $letter = C4::Letters::GetPreparedLetter(
1727 letter_code => $params->{notice_code},
1728 branchcode => $self->branchcode,
1729 message_transport_type => $params->{transport},
1730 lang => $self->patron->lang,
1732 illrequests => $self->illrequest_id,
1733 borrowers => $self->borrowernumber,
1734 biblio => $self->biblio_id,
1735 branches => $self->branchcode,
1738 ill_bib_title => $title ? $title->value : '',
1739 ill_bib_author => $author ? $author->value : '',
1740 ill_full_metadata => $metastring,
1741 additional_text => $params->{additional_text},
1742 illrequestattributes => $illrequestattributes,
1750 =head3 attach_processors
1752 Receive a Koha::Illrequest::SupplierUpdate and attach
1753 any processors we have for it
1757 sub attach_processors {
1758 my ( $self, $update ) = @_;
1760 foreach my $processor(@{$self->{processors}}) {
1762 $processor->{target_source_type} eq $update->{source_type} &&
1763 $processor->{target_source_name} eq $update->{source_name}
1765 $update->attach_processor($processor);
1770 =head3 append_to_note
1772 append_to_note("Some text");
1774 Append some text to the staff note
1778 sub append_to_note {
1779 my ($self, $text) = @_;
1780 my $current = $self->notesstaff;
1781 $text = ($current && length $current > 0) ? "$current\n\n$text" : $text;
1782 $self->notesstaff($text)->store;
1787 my $prefix = $record->id_prefix;
1789 Return the prefix appropriate for the current Illrequest as derived from the
1790 borrower and branch associated with this request's Status, and the config
1797 my $prefix = $self->getPrefix( {
1798 branch => $self->branchcode,
1800 $prefix .= "-" if ( $prefix );
1806 my $params = $illRequest->_censor($params);
1808 Return $params, modified to reflect our censorship requirements.
1813 my ( $self, $params ) = @_;
1814 my $censorship = $self->_config->censorship;
1815 $params->{censor_notes_staff} = $censorship->{censor_notes_staff}
1816 if ( $params->{opac} );
1817 $params->{display_reply_date} = ( $censorship->{censor_reply_date} ) ? 0 : 1;
1826 Overloaded I<store> method that, in addition to performing the 'store',
1827 possibly records the fact that something happened
1832 my ( $self, $attrs ) = @_;
1834 my %updated_columns = $self->_result->get_dirty_columns;
1837 if( $self->in_storage and defined $updated_columns{'borrowernumber'} and
1838 Koha::Patrons->find( $updated_columns{'borrowernumber'} ) )
1840 # borrowernumber has changed
1841 my $old_illreq = $self->get_from_storage;
1842 @holds = Koha::Holds->search( {
1843 borrowernumber => $old_illreq->borrowernumber,
1844 biblionumber => $self->biblio_id,
1845 } )->as_list if $old_illreq;
1848 my $ret = $self->SUPER::store;
1850 if ( scalar @holds ) {
1851 # move holds to the changed borrowernumber
1852 foreach my $hold ( @holds ) {
1853 $hold->borrowernumber( $updated_columns{'borrowernumber'} )->store;
1857 $attrs->{log_origin} = 'core';
1859 if ($ret && defined $attrs) {
1860 my $logger = Koha::Illrequest::Logger->new;
1861 $logger->log_maybe({
1870 =head3 requested_partners
1872 my $partners_string = $illRequest->requested_partners;
1874 Return the string representing the email addresses of the partners to
1875 whom a request has been sent
1879 sub requested_partners {
1881 return $self->_backend_capability(
1882 'get_requested_partners',
1883 { request => $self }
1889 $json = $illrequest->TO_JSON
1891 Overloaded I<TO_JSON> method that takes care of inserting calculated values
1892 into the unblessed representation of the object.
1894 TODO: This method does nothing and is not called anywhere. However, bug 74325
1895 touches it, so keeping this for now until both this and bug 74325 are merged,
1896 at which point we can sort it out and remove it completely
1901 my ( $self, $embed ) = @_;
1903 my $object = $self->SUPER::TO_JSON();
1908 =head2 Internal methods
1910 =head3 to_api_mapping
1914 sub to_api_mapping {
1916 accessurl => 'access_url',
1917 batch_id => 'ill_batch_id',
1918 backend => 'ill_backend_id',
1919 borrowernumber => 'patron_id',
1920 branchcode => 'library_id',
1921 completed => 'completed_date',
1922 deleted_biblio_id => undef,
1923 illrequest_id => 'ill_request_id',
1924 notesopac => 'opac_notes',
1925 notesstaff => 'staff_notes',
1926 orderid => 'ill_backend_request_id',
1927 placed => 'requested_date',
1928 price_paid => 'paid_price',
1929 replied => 'replied_date',
1930 status_alias => 'status_av',
1931 updated => 'timestamp',
1937 my $strings = $self->string_map({ [ public => 0|1 ] });
1939 Returns a map of column name to string representations. Extra information
1940 is returned depending on the column characteristics as shown below.
1942 Accepts a param hashref where the I<public> key denotes whether we want the public
1943 or staff client strings.
1949 backend => 'backendName',
1950 str => 'Status description',
1951 type => 'ill_status',
1954 category => 'ILL_STATUS_ALIAS,
1955 str => $value, # the AV description, depending on $params->{public}
1963 my ( $self, $params ) = @_;
1965 my $cache = Koha::Cache::Memory::Lite->get_instance();
1966 my $cache_key = 'ill:status_graph:' . $self->backend;
1968 my $status_graph_union = $cache->get($cache_key);
1969 unless ($status_graph_union) {
1970 $status_graph_union = $self->capabilities;
1971 $cache->set( $cache_key, $status_graph_union );
1975 ( exists $status_graph_union->{ $self->status } && defined $status_graph_union->{ $self->status }->{name} )
1976 ? $status_graph_union->{ $self->status }->{name}
1980 ( exists $status_graph_union->{ $self->status } && defined $status_graph_union->{ $self->status }->{id} )
1981 ? $status_graph_union->{ $self->status }->{id}
1986 backend => $self->backend, # the backend identifier
1987 str => $status_string, # the status description, taken from the status graph
1988 code => $status_code, # the status id, taken from the status graph
1989 type => 'ill_status', # fixed type
1993 my $status_alias = $self->statusalias;
1994 if ($status_alias) {
1995 $strings->{"status_alias"} = {
1996 category => 'ILL_STATUS_ALIAS',
1997 str => $params->{public} ? $status_alias->lib_opac : $status_alias->lib,
1998 code => $status_alias->authorised_value,
2007 =head3 get_op_param_deprecation
2009 my $op = Koha::Illrequest->check_url_param_deprecation($params);
2011 Issues a deprecation message for the given parameters, if needed.
2012 Returns the appropriate operation based on the interface type.
2018 The interface this is running on: 'opac' or 'intranet'
2032 sub get_op_param_deprecation {
2033 my ( $self, $interface, $params ) = @_;
2035 my $deprecation_message;
2037 $deprecation_message = '"method" form param is DEPRECATED in favor of "op". ' if ( exists( $params->{'method'} ) );
2039 if ( exists( $params->{'op'} ) && $params->{'op'} eq 'create'
2040 || exists( $params->{'method'} ) && $params->{'method'} eq 'create' )
2042 $deprecation_message .= '"create" op is DEPRECATED in favor of "cud-create" or "add_form".';
2045 $deprecation_message .= ' Used by ' . $params->{'backend'} . ' backend.'
2046 if $params->{'backend'} && $deprecation_message;
2048 deprecated $deprecation_message if $deprecation_message;
2051 if ( $interface eq 'opac' ) {
2052 $op = $params->{'op'} // $params->{'method'} // 'list';
2053 $op = 'cud-create' if $op eq 'create' || $op eq 'add_form';
2054 } elsif ( $interface eq 'intranet' ) {
2055 $op = $params->{op} // $params->{method} // 'illlist';
2056 $op = 'cud-create' if $op eq 'create';
2057 $op = 'cud-cancel' if $op eq 'cancel';
2058 $op = 'cud-delete' if $op eq 'delete';
2068 return 'Illrequest';
2073 Alex Sassmannshausen <alex.sassmannshausen@ptfs-europe.com>
2074 Andrew Isherwood <andrew.isherwood@ptfs-europe.com>