Bug 18309: UNIMARC update from IFLA - authority (fr) (STU)
[koha.git] / Koha / Illrequest.pm
blob4f9623a9f587d2086678ace5465b0a15e1f28a45
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 _status_graph_union
491 my $status_graph = $illrequest->_status_graph_union($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 eq $_ } @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 eq $_ } @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 other => $params,
789 backend => $self->_backend->name
792 } elsif ( defined $params->{stage}
793 && $params->{stage} eq 'copyrightclearance' ) {
794 $params->{stage} = 'init';
797 # First perform API action, then...
798 my $args = {
799 request => $self,
800 other => $params,
802 my $result = $self->_backend->create($args);
804 # ... simple case: we're not at 'commit' stage.
805 my $stage = $result->{stage};
806 return $self->expandTemplate($result)
807 unless ( 'commit' eq $stage );
809 # ... complex case: commit!
811 # Do we still have space for an ILL or should we queue?
812 my $permitted = $self->check_limits(
813 { patron => $self->patron }, { librarycode => $self->branchcode }
816 # Now augment our committed request.
818 $result->{permitted} = $permitted; # Queue request?
820 # This involves...
822 # ...Updating status!
823 $self->status('QUEUED')->store unless ( $permitted );
825 ## Handle Unmediated ILLs
827 # For the unmediated workflow we only need to delegate to our backend. If
828 # that backend supports unmediateld_ill, it will do its thing and return a
829 # proper response. If it doesn't then _backend_capability returns 0, so
830 # we keep the current result.
831 if ( C4::Context->preference("ILLModuleUnmediated") && $permitted ) {
832 my $unmediated_result = $self->_backend_capability(
833 'unmediated_ill',
834 $args
836 $result = $unmediated_result if $unmediated_result;
839 return $self->expandTemplate($result);
842 =head3 expandTemplate
844 my $params = $abstract->expandTemplate($params);
846 Return a version of $PARAMS augmented with our required template path.
848 =cut
850 sub expandTemplate {
851 my ( $self, $params ) = @_;
852 my $backend = $self->_backend->name;
853 # Generate path to file to load
854 my $backend_dir = $self->_config->backend_dir;
855 my $backend_tmpl = join "/", $backend_dir, $backend;
856 my $intra_tmpl = join "/", $backend_tmpl, "intra-includes",
857 $params->{method} . ".inc";
858 my $opac_tmpl = join "/", $backend_tmpl, "opac-includes",
859 $params->{method} . ".inc";
860 # Set files to load
861 $params->{template} = $intra_tmpl;
862 $params->{opac_template} = $opac_tmpl;
863 return $params;
866 #### Abstract Imports
868 =head3 getLimits
870 my $limit_rules = $abstract->getLimits( {
871 type => 'brw_cat' | 'branch',
872 value => $value
873 } );
875 Return the ILL limit rules for the supplied combination of type / value.
877 As the config may have no rules for this particular type / value combination,
878 or for the default, we must define fall-back values here.
880 =cut
882 sub getLimits {
883 my ( $self, $params ) = @_;
884 my $limits = $self->_config->getLimitRules($params->{type});
886 if ( defined $params->{value}
887 && defined $limits->{$params->{value}} ) {
888 return $limits->{$params->{value}};
890 else {
891 return $limits->{default} || { count => -1, method => 'active' };
895 =head3 getPrefix
897 my $prefix = $abstract->getPrefix( {
898 branch => $branch_code
899 } );
901 Return the ILL prefix as defined by our $params: either per borrower category,
902 per branch or the default.
904 =cut
906 sub getPrefix {
907 my ( $self, $params ) = @_;
908 my $brn_prefixes = $self->_config->getPrefixes();
909 return $brn_prefixes->{$params->{branch}} || ""; # "the empty prefix"
912 =head3 get_type
914 my $type = $abstract->get_type();
916 Return a string representing the material type of this request or undef
918 =cut
920 sub get_type {
921 my ($self) = @_;
922 my $attr = $self->illrequestattributes->find({ type => 'type'});
923 return if !$attr;
924 return $attr->value;
927 #### Illrequests Imports
929 =head3 check_limits
931 my $ok = $illRequests->check_limits( {
932 borrower => $borrower,
933 branchcode => 'branchcode' | undef,
934 } );
936 Given $PARAMS, a hashref containing a $borrower object and a $branchcode,
937 see whether we are still able to place ILLs.
939 LimitRules are derived from koha-conf.xml:
940 + default limit counts, and counting method
941 + branch specific limit counts & counting method
942 + borrower category specific limit counts & counting method
943 + err on the side of caution: a counting fail will cause fail, even if
944 the other counts passes.
946 =cut
948 sub check_limits {
949 my ( $self, $params ) = @_;
950 my $patron = $params->{patron};
951 my $branchcode = $params->{librarycode} || $patron->branchcode;
953 # Establish maximum number of allowed requests
954 my ( $branch_rules, $brw_rules ) = (
955 $self->getLimits( {
956 type => 'branch',
957 value => $branchcode
958 } ),
959 $self->getLimits( {
960 type => 'brw_cat',
961 value => $patron->categorycode,
962 } ),
964 my ( $branch_limit, $brw_limit )
965 = ( $branch_rules->{count}, $brw_rules->{count} );
966 # Establish currently existing requests
967 my ( $branch_count, $brw_count ) = (
968 $self->_limit_counter(
969 $branch_rules->{method}, { branchcode => $branchcode }
971 $self->_limit_counter(
972 $brw_rules->{method}, { borrowernumber => $patron->borrowernumber }
976 # Compare and return
977 # A limit of -1 means no limit exists.
978 # We return blocked if either branch limit or brw limit is reached.
979 if ( ( $branch_limit != -1 && $branch_limit <= $branch_count )
980 || ( $brw_limit != -1 && $brw_limit <= $brw_count ) ) {
981 return 0;
982 } else {
983 return 1;
987 sub _limit_counter {
988 my ( $self, $method, $target ) = @_;
990 # Establish parameters of counts
991 my $resultset;
992 if ($method && $method eq 'annual') {
993 $resultset = Koha::Illrequests->search({
994 -and => [
995 %{$target},
996 \"YEAR(placed) = YEAR(NOW())"
999 } else { # assume 'active'
1000 # XXX: This status list is ugly. There should be a method in config
1001 # to return these.
1002 my $where = { status => { -not_in => [ 'QUEUED', 'COMP' ] } };
1003 $resultset = Koha::Illrequests->search({ %{$target}, %{$where} });
1006 # Fetch counts
1007 return $resultset->count;
1010 =head3 requires_moderation
1012 my $status = $illRequest->requires_moderation;
1014 Return the name of the status if moderation by staff is required; or 0
1015 otherwise.
1017 =cut
1019 sub requires_moderation {
1020 my ( $self ) = @_;
1021 my $require_moderation = {
1022 'CANCREQ' => 'CANCREQ',
1024 return $require_moderation->{$self->status};
1027 =head3 generic_confirm
1029 my $stage_summary = $illRequest->generic_confirm;
1031 Handle the generic_confirm extended method. The first stage involves creating
1032 a template email for the end user to edit in the browser. The second stage
1033 attempts to submit the email.
1035 =cut
1037 sub generic_confirm {
1038 my ( $self, $params ) = @_;
1039 my $branch = Koha::Libraries->find($params->{current_branchcode})
1040 || die "Invalid current branchcode. Are you logged in as the database user?";
1041 if ( !$params->{stage}|| $params->{stage} eq 'init' ) {
1042 my $draft->{subject} = "ILL Request";
1043 $draft->{body} = <<EOF;
1044 Dear Sir/Madam,
1046 We would like to request an interlibrary loan for a title matching the
1047 following description:
1051 my $details = $self->metadata;
1052 while (my ($title, $value) = each %{$details}) {
1053 $draft->{body} .= " - " . $title . ": " . $value . "\n"
1054 if $value;
1056 $draft->{body} .= <<EOF;
1058 Please let us know if you are able to supply this to us.
1060 Kind Regards
1064 my @address = map { $branch->$_ }
1065 qw/ branchname branchaddress1 branchaddress2 branchaddress3
1066 branchzip branchcity branchstate branchcountry branchphone
1067 branchemail /;
1068 my $address = "";
1069 foreach my $line ( @address ) {
1070 $address .= $line . "\n" if $line;
1073 $draft->{body} .= $address;
1075 my $partners = Koha::Patrons->search({
1076 categorycode => $self->_config->partner_code
1078 return {
1079 error => 0,
1080 status => '',
1081 message => '',
1082 method => 'generic_confirm',
1083 stage => 'draft',
1084 value => {
1085 draft => $draft,
1086 partners => $partners,
1090 } elsif ( 'draft' eq $params->{stage} ) {
1091 # Create the to header
1092 my $to = $params->{partners};
1093 if ( defined $to ) {
1094 $to =~ s/^\x00//; # Strip leading NULLs
1095 $to =~ s/\x00/; /; # Replace others with '; '
1097 Koha::Exceptions::Ill::NoTargetEmail->throw(
1098 "No target email addresses found. Either select at least one partner or check your ILL partner library records.")
1099 if ( !$to );
1100 # Create the from, replyto and sender headers
1101 my $from = $branch->branchemail;
1102 my $replyto = $branch->branchreplyto || $from;
1103 Koha::Exceptions::Ill::NoLibraryEmail->throw(
1104 "Your library has no usable email address. Please set it.")
1105 if ( !$from );
1107 # Create the email
1108 my $message = Koha::Email->new;
1109 my %mail = $message->create_message_headers(
1111 to => $to,
1112 from => $from,
1113 replyto => $replyto,
1114 subject => Encode::encode( "utf8", $params->{subject} ),
1115 message => Encode::encode( "utf8", $params->{body} ),
1116 contenttype => 'text/plain',
1119 # Send it
1120 my $result = sendmail(%mail);
1121 if ( $result ) {
1122 $self->status("GENREQ")->store;
1123 $self->_backend_capability(
1124 'set_requested_partners',
1126 request => $self,
1127 to => $to
1130 return {
1131 error => 0,
1132 status => '',
1133 message => '',
1134 method => 'generic_confirm',
1135 stage => 'commit',
1136 next => 'illview',
1138 } else {
1139 return {
1140 error => 1,
1141 status => 'email_failed',
1142 message => $Mail::Sendmail::error,
1143 method => 'generic_confirm',
1144 stage => 'draft',
1147 } else {
1148 die "Unknown stage, should not have happened."
1152 =head3 id_prefix
1154 my $prefix = $record->id_prefix;
1156 Return the prefix appropriate for the current Illrequest as derived from the
1157 borrower and branch associated with this request's Status, and the config
1158 file.
1160 =cut
1162 sub id_prefix {
1163 my ( $self ) = @_;
1164 my $prefix = $self->getPrefix( {
1165 branch => $self->branchcode,
1166 } );
1167 $prefix .= "-" if ( $prefix );
1168 return $prefix;
1171 =head3 _censor
1173 my $params = $illRequest->_censor($params);
1175 Return $params, modified to reflect our censorship requirements.
1177 =cut
1179 sub _censor {
1180 my ( $self, $params ) = @_;
1181 my $censorship = $self->_config->censorship;
1182 $params->{censor_notes_staff} = $censorship->{censor_notes_staff}
1183 if ( $params->{opac} );
1184 $params->{display_reply_date} = ( $censorship->{censor_reply_date} ) ? 0 : 1;
1186 return $params;
1189 =head3 store
1191 $Illrequest->store;
1193 Overloaded I<store> method that, in addition to performing the 'store',
1194 possibly records the fact that something happened
1196 =cut
1198 sub store {
1199 my ( $self, $attrs ) = @_;
1201 my $ret = $self->SUPER::store;
1203 $attrs->{log_origin} = 'core';
1205 if ($ret && defined $attrs) {
1206 my $logger = Koha::Illrequest::Logger->new;
1207 $logger->log_maybe({
1208 request => $self,
1209 attrs => $attrs
1213 return $ret;
1216 =head3 requested_partners
1218 my $partners_string = $illRequest->requested_partners;
1220 Return the string representing the email addresses of the partners to
1221 whom a request has been sent
1223 =cut
1225 sub requested_partners {
1226 my ( $self ) = @_;
1227 return $self->_backend_capability(
1228 'get_requested_partners',
1229 { request => $self }
1233 =head3 TO_JSON
1235 $json = $illrequest->TO_JSON
1237 Overloaded I<TO_JSON> method that takes care of inserting calculated values
1238 into the unblessed representation of the object.
1240 TODO: This method does nothing and is not called anywhere. However, bug 74325
1241 touches it, so keeping this for now until both this and bug 74325 are merged,
1242 at which point we can sort it out and remove it completely
1244 =cut
1246 sub TO_JSON {
1247 my ( $self, $embed ) = @_;
1249 my $object = $self->SUPER::TO_JSON();
1251 return $object;
1254 =head2 Internal methods
1256 =head3 _type
1258 =cut
1260 sub _type {
1261 return 'Illrequest';
1264 =head1 AUTHOR
1266 Alex Sassmannshausen <alex.sassmannshausen@ptfs-europe.com>
1267 Andrew Isherwood <andrew.isherwood@ptfs-europe.com>
1269 =cut