package Koha::Illrequest; # Copyright PTFS Europe 2016 # # This file is part of Koha. # # Koha is free software; you can redistribute it and/or modify it under the # terms of the GNU General Public License as published by the Free Software # Foundation; either version 3 of the License, or (at your option) any later # version. # # Koha is distributed in the hope that it will be useful, but WITHOUT ANY # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS # FOR A PARTICULAR PURPOSE. See the GNU General Public License for more # details. # # You should have received a copy of the GNU General Public License along with # Koha; if not, write to the Free Software Foundation, Inc., 51 Franklin # Street, Fifth Floor, Boston, MA 02110-1301 USA. use Modern::Perl; use Clone 'clone'; use File::Basename qw( basename ); use Encode qw( encode ); use Mail::Sendmail; use Try::Tiny; use Koha::Database; use Koha::Email; use Koha::Exceptions::Ill; use Koha::Illcomments; use Koha::Illrequestattributes; use Koha::Patron; use base qw(Koha::Object); =head1 NAME Koha::Illrequest - Koha Illrequest Object class =head1 (Re)Design An ILLRequest consists of two parts; the Illrequest Koha::Object, and a series of related Illrequestattributes. The former encapsulates the basic necessary information that any ILL requires to be usable in Koha. The latter is a set of additional properties used by one of the backends. The former subsumes the legacy "Status" object. The latter remains encapsulated in the "Record" object. TODO: - Anything invoking the ->status method; annotated with: + # Old use of ->status ! =head1 API =head2 Backend API Response Principles All methods should return a hashref in the following format: =over =item * error This should be set to 1 if an error was encountered. =item * status The status should be a string from the list of statuses detailed below. =item * message The message is a free text field that can be passed on to the end user. =item * value The value returned by the method. =back =head2 Interface Status Messages =over =item * branch_address_incomplete An interface request has determined branch address details are incomplete. =item * cancel_success The interface's cancel_request method was successful in cancelling the Illrequest using the API. =item * cancel_fail The interface's cancel_request method failed to cancel the Illrequest using the API. =item * unavailable The interface's request method returned saying that the desired item is not available for request. =back =head2 Class methods =head3 illrequestattributes =cut sub illrequestattributes { my ( $self ) = @_; return Koha::Illrequestattributes->_new_from_dbic( scalar $self->_result->illrequestattributes ); } =head3 illcomments =cut sub illcomments { my ( $self ) = @_; return Koha::Illcomments->_new_from_dbic( scalar $self->_result->illcomments ); } =head3 patron =cut sub patron { my ( $self ) = @_; return Koha::Patron->_new_from_dbic( scalar $self->_result->borrowernumber ); } =head3 load_backend Require "Base.pm" from the relevant ILL backend. =cut sub load_backend { my ( $self, $backend_id ) = @_; my @raw = qw/Koha Illbackends/; # Base Path my $backend_name = $backend_id || $self->backend; unless ( defined $backend_name && $backend_name ne '' ) { Koha::Exceptions::Ill::InvalidBackendId->throw( "An invalid backend ID was requested ('')"); } my $location = join "/", @raw, $backend_name, "Base.pm"; # File to load my $backend_class = join "::", @raw, $backend_name, "Base"; # Package name require $location; $self->{_my_backend} = $backend_class->new({ config => $self->_config }); return $self; } =head3 _backend my $backend = $abstract->_backend($new_backend); my $backend = $abstract->_backend; Getter/Setter for our API object. =cut sub _backend { my ( $self, $backend ) = @_; $self->{_my_backend} = $backend if ( $backend ); # Dynamically load our backend object, as late as possible. $self->load_backend unless ( $self->{_my_backend} ); return $self->{_my_backend}; } =head3 _backend_capability my $backend_capability_result = $self->_backend_capability($name, $args); This is a helper method to invoke optional capabilities in the backend. If the capability named by $name is not supported, return 0, else invoke it, passing $args along with the invocation, and return its return value. NOTE: this module suffers from a confusion in termninology: in _backend_capability, the notion of capability refers to an optional feature that is implemented in core, but might not be supported by a given backend. in capabilities & custom_capability, capability refers to entries in the status_graph (after union between backend and core). The easiest way to fix this would be to fix the terminology in capabilities & custom_capability and their callers. =cut sub _backend_capability { my ( $self, $name, $args ) = @_; my $capability = 0; try { $capability = $self->_backend->capabilities($name); } catch { return 0; }; if ( $capability ) { return &{$capability}($args); } else { return 0; } } =head3 _config my $config = $abstract->_config($config); my $config = $abstract->_config; Getter/Setter for our config object. =cut sub _config { my ( $self, $config ) = @_; $self->{_my_config} = $config if ( $config ); # Load our config object, as late as possible. unless ( $self->{_my_config} ) { $self->{_my_config} = Koha::Illrequest::Config->new; } return $self->{_my_config}; } =head3 metadata =cut sub metadata { my ( $self ) = @_; return $self->_backend->metadata($self); } =head3 _core_status_graph my $core_status_graph = $illrequest->_core_status_graph; Returns ILL module's default status graph. A status graph defines the list of available actions at any stage in the ILL workflow. This is for instance used by the perl script & template to generate the correct buttons to display to the end user at any given point. =cut sub _core_status_graph { my ( $self ) = @_; return { NEW => { prev_actions => [ ], # Actions containing buttons # leading to this status id => 'NEW', # ID of this status name => 'New request', # UI name of this status ui_method_name => 'New request', # UI name of method leading # to this status method => 'create', # method to this status next_actions => [ 'REQ', 'GENREQ', 'KILL' ], # buttons to add to all # requests with this status ui_method_icon => 'fa-plus', # UI Style class }, REQ => { prev_actions => [ 'NEW', 'REQREV', 'QUEUED', 'CANCREQ' ], id => 'REQ', name => 'Requested', ui_method_name => 'Confirm request', method => 'confirm', next_actions => [ 'REQREV', 'COMP' ], ui_method_icon => 'fa-check', }, GENREQ => { prev_actions => [ 'NEW', 'REQREV' ], id => 'GENREQ', name => 'Requested from partners', ui_method_name => 'Place request with partners', method => 'generic_confirm', next_actions => [ 'COMP' ], ui_method_icon => 'fa-send-o', }, REQREV => { prev_actions => [ 'REQ' ], id => 'REQREV', name => 'Request reverted', ui_method_name => 'Revert Request', method => 'cancel', next_actions => [ 'REQ', 'GENREQ', 'KILL' ], ui_method_icon => 'fa-times', }, QUEUED => { prev_actions => [ ], id => 'QUEUED', name => 'Queued request', ui_method_name => 0, method => 0, next_actions => [ 'REQ', 'KILL' ], ui_method_icon => 0, }, CANCREQ => { prev_actions => [ 'NEW' ], id => 'CANCREQ', name => 'Cancellation requested', ui_method_name => 0, method => 0, next_actions => [ 'KILL', 'REQ' ], ui_method_icon => 0, }, COMP => { prev_actions => [ 'REQ' ], id => 'COMP', name => 'Completed', ui_method_name => 'Mark completed', method => 'mark_completed', next_actions => [ ], ui_method_icon => 'fa-check', }, KILL => { prev_actions => [ 'QUEUED', 'REQREV', 'NEW', 'CANCREQ' ], id => 'KILL', name => 0, ui_method_name => 'Delete request', method => 'delete', next_actions => [ ], ui_method_icon => 'fa-trash', }, }; } =head3 _core_status_graph my $status_graph = $illrequest->_core_status_graph($origin, $new_graph); Return a new status_graph, the result of merging $origin & new_graph. This is operation is a union over the sets defied by the two graphs. Each entry in $new_graph is added to $origin. We do not provide a syntax for 'subtraction' of entries from $origin. Whilst it is not intended that this works, you can override entries in $origin with entries with the same key in $new_graph. This can lead to problematic behaviour when $new_graph adds an entry, which modifies a dependent entry in $origin, only for the entry in $origin to be replaced later with a new entry from $new_graph. NOTE: this procedure does not "re-link" entries in $origin or $new_graph, i.e. each of the graphs need to be correct at the outset of the operation. =cut sub _status_graph_union { my ( $self, $core_status_graph, $backend_status_graph ) = @_; # Create new status graph with: # - all core_status_graph # - for-each each backend_status_graph # + add to new status graph # + for each core prev_action: # * locate core_status # * update next_actions with additional next action. # + for each core next_action: # * locate core_status # * update prev_actions with additional prev action my @core_status_ids = keys %{$core_status_graph}; my $status_graph = clone($core_status_graph); foreach my $backend_status_key ( keys %{$backend_status_graph} ) { my $backend_status = $backend_status_graph->{$backend_status_key}; # Add to new status graph $status_graph->{$backend_status_key} = $backend_status; # Update all core methods' next_actions. foreach my $prev_action ( @{$backend_status->{prev_actions}} ) { if ( grep $prev_action, @core_status_ids ) { my @next_actions = @{$status_graph->{$prev_action}->{next_actions}}; push @next_actions, $backend_status_key; $status_graph->{$prev_action}->{next_actions} = \@next_actions; } } # Update all core methods' prev_actions foreach my $next_action ( @{$backend_status->{next_actions}} ) { if ( grep $next_action, @core_status_ids ) { my @prev_actions = @{$status_graph->{$next_action}->{prev_actions}}; push @prev_actions, $backend_status_key; $status_graph->{$next_action}->{prev_actions} = \@prev_actions; } } } return $status_graph; } ### Core API methods =head3 capabilities my $capabilities = $illrequest->capabilities; Return a hashref mapping methods to operation names supported by the queried backend. Example return value: { create => "Create Request", confirm => "Progress Request" } NOTE: this module suffers from a confusion in termninology: in _backend_capability, the notion of capability refers to an optional feature that is implemented in core, but might not be supported by a given backend. in capabilities & custom_capability, capability refers to entries in the status_graph (after union between backend and core). The easiest way to fix this would be to fix the terminology in capabilities & custom_capability and their callers. =cut sub capabilities { my ( $self, $status ) = @_; # Generate up to date status_graph my $status_graph = $self->_status_graph_union( $self->_core_status_graph, $self->_backend->status_graph({ request => $self, other => {} }) ); # Extract available actions from graph. return $status_graph->{$status} if $status; # Or return entire graph. return $status_graph; } =head3 custom_capability Return the result of invoking $CANDIDATE on this request's backend with $PARAMS, or 0 if $CANDIDATE is an unknown method on backend. NOTE: this module suffers from a confusion in termninology: in _backend_capability, the notion of capability refers to an optional feature that is implemented in core, but might not be supported by a given backend. in capabilities & custom_capability, capability refers to entries in the status_graph (after union between backend and core). The easiest way to fix this would be to fix the terminology in capabilities & custom_capability and their callers. =cut sub custom_capability { my ( $self, $candidate, $params ) = @_; foreach my $capability ( values %{$self->capabilities} ) { if ( $candidate eq $capability->{method} ) { my $response = $self->_backend->$candidate({ request => $self, other => $params, }); return $self->expandTemplate($response); } } return 0; } =head3 available_backends Return a list of available backends. =cut sub available_backends { my ( $self ) = @_; my $backends = $self->_config->available_backends; return $backends; } =head3 available_actions Return a list of available actions. =cut sub available_actions { my ( $self ) = @_; my $current_action = $self->capabilities($self->status); my @available_actions = map { $self->capabilities($_) } @{$current_action->{next_actions}}; return \@available_actions; } =head3 mark_completed Mark a request as completed (status = COMP). =cut sub mark_completed { my ( $self ) = @_; $self->status('COMP')->store; return { error => 0, status => '', message => '', method => 'mark_completed', stage => 'commit', next => 'illview', }; } =head2 backend_confirm Confirm a request. The backend handles setting of mandatory fields in the commit stage: =over =item * orderid =item * accessurl, cost (if available). =back =cut sub backend_confirm { my ( $self, $params ) = @_; my $response = $self->_backend->confirm({ request => $self, other => $params, }); return $self->expandTemplate($response); } =head3 backend_update_status =cut sub backend_update_status { my ( $self, $params ) = @_; return $self->expandTemplate($self->_backend->update_status($params)); } =head3 backend_cancel my $ILLResponse = $illRequest->backend_cancel; The standard interface method allowing for request cancellation. =cut sub backend_cancel { my ( $self, $params ) = @_; my $result = $self->_backend->cancel({ request => $self, other => $params }); return $self->expandTemplate($result); } =head3 backend_renew my $renew_response = $illRequest->backend_renew; The standard interface method allowing for request renewal queries. =cut sub backend_renew { my ( $self ) = @_; return $self->expandTemplate( $self->_backend->renew({ request => $self, }) ); } =head3 backend_create my $create_response = $abstractILL->backend_create($params); Return an array of Record objects created by querying our backend with a Search query. In the context of the other ILL methods, this is a special method: we only pass it $params, as it does not yet have any other data associated with it. =cut sub backend_create { my ( $self, $params ) = @_; # Establish whether we need to do a generic copyright clearance. if ($params->{opac}) { if ( ( !$params->{stage} || $params->{stage} eq 'init' ) && C4::Context->preference("ILLModuleCopyrightClearance") ) { return { error => 0, status => '', message => '', method => 'create', stage => 'copyrightclearance', value => { other => $params, backend => $self->_backend->name } }; } elsif ( defined $params->{stage} && $params->{stage} eq 'copyrightclearance' ) { $params->{stage} = 'init'; } } # First perform API action, then... my $args = { request => $self, other => $params, }; my $result = $self->_backend->create($args); # ... simple case: we're not at 'commit' stage. my $stage = $result->{stage}; return $self->expandTemplate($result) unless ( 'commit' eq $stage ); # ... complex case: commit! # Do we still have space for an ILL or should we queue? my $permitted = $self->check_limits( { patron => $self->patron }, { librarycode => $self->branchcode } ); # Now augment our committed request. $result->{permitted} = $permitted; # Queue request? # This involves... # ...Updating status! $self->status('QUEUED')->store unless ( $permitted ); return $self->expandTemplate($result); } =head3 expandTemplate my $params = $abstract->expandTemplate($params); Return a version of $PARAMS augmented with our required template path. =cut sub expandTemplate { my ( $self, $params ) = @_; my $backend = $self->_backend->name; # Generate path to file to load my $backend_dir = $self->_config->backend_dir; my $backend_tmpl = join "/", $backend_dir, $backend; my $intra_tmpl = join "/", $backend_tmpl, "intra-includes", $params->{method} . ".inc"; my $opac_tmpl = join "/", $backend_tmpl, "opac-includes", $params->{method} . ".inc"; # Set files to load $params->{template} = $intra_tmpl; $params->{opac_template} = $opac_tmpl; return $params; } #### Abstract Imports =head3 getLimits my $limit_rules = $abstract->getLimits( { type => 'brw_cat' | 'branch', value => $value } ); Return the ILL limit rules for the supplied combination of type / value. As the config may have no rules for this particular type / value combination, or for the default, we must define fall-back values here. =cut sub getLimits { my ( $self, $params ) = @_; my $limits = $self->_config->getLimitRules($params->{type}); if ( defined $params->{value} && defined $limits->{$params->{value}} ) { return $limits->{$params->{value}}; } else { return $limits->{default} || { count => -1, method => 'active' }; } } =head3 getPrefix my $prefix = $abstract->getPrefix( { branch => $branch_code } ); Return the ILL prefix as defined by our $params: either per borrower category, per branch or the default. =cut sub getPrefix { my ( $self, $params ) = @_; my $brn_prefixes = $self->_config->getPrefixes(); return $brn_prefixes->{$params->{branch}} || ""; # "the empty prefix" } =head3 get_type my $type = $abstract->get_type(); Return a string representing the material type of this request or undef =cut sub get_type { my ($self) = @_; my $attr = $self->illrequestattributes->find({ type => 'type'}); return if !$attr; return $attr->value; }; #### Illrequests Imports =head3 check_limits my $ok = $illRequests->check_limits( { borrower => $borrower, branchcode => 'branchcode' | undef, } ); Given $PARAMS, a hashref containing a $borrower object and a $branchcode, see whether we are still able to place ILLs. LimitRules are derived from koha-conf.xml: + default limit counts, and counting method + branch specific limit counts & counting method + borrower category specific limit counts & counting method + err on the side of caution: a counting fail will cause fail, even if the other counts passes. =cut sub check_limits { my ( $self, $params ) = @_; my $patron = $params->{patron}; my $branchcode = $params->{librarycode} || $patron->branchcode; # Establish maximum number of allowed requests my ( $branch_rules, $brw_rules ) = ( $self->getLimits( { type => 'branch', value => $branchcode } ), $self->getLimits( { type => 'brw_cat', value => $patron->categorycode, } ), ); my ( $branch_limit, $brw_limit ) = ( $branch_rules->{count}, $brw_rules->{count} ); # Establish currently existing requests my ( $branch_count, $brw_count ) = ( $self->_limit_counter( $branch_rules->{method}, { branchcode => $branchcode } ), $self->_limit_counter( $brw_rules->{method}, { borrowernumber => $patron->borrowernumber } ), ); # Compare and return # A limit of -1 means no limit exists. # We return blocked if either branch limit or brw limit is reached. if ( ( $branch_limit != -1 && $branch_limit <= $branch_count ) || ( $brw_limit != -1 && $brw_limit <= $brw_count ) ) { return 0; } else { return 1; } } sub _limit_counter { my ( $self, $method, $target ) = @_; # Establish parameters of counts my $resultset; if ($method && $method eq 'annual') { $resultset = Koha::Illrequests->search({ -and => [ %{$target}, \"YEAR(placed) = YEAR(NOW())" ] }); } else { # assume 'active' # XXX: This status list is ugly. There should be a method in config # to return these. my $where = { status => { -not_in => [ 'QUEUED', 'COMP' ] } }; $resultset = Koha::Illrequests->search({ %{$target}, %{$where} }); } # Fetch counts return $resultset->count; } =head3 requires_moderation my $status = $illRequest->requires_moderation; Return the name of the status if moderation by staff is required; or 0 otherwise. =cut sub requires_moderation { my ( $self ) = @_; my $require_moderation = { 'CANCREQ' => 'CANCREQ', }; return $require_moderation->{$self->status}; } =head3 generic_confirm my $stage_summary = $illRequest->generic_confirm; Handle the generic_confirm extended method. The first stage involves creating a template email for the end user to edit in the browser. The second stage attempts to submit the email. =cut sub generic_confirm { my ( $self, $params ) = @_; my $branch = Koha::Libraries->find($params->{current_branchcode}) || die "Invalid current branchcode. Are you logged in as the database user?"; if ( !$params->{stage}|| $params->{stage} eq 'init' ) { my $draft->{subject} = "ILL Request"; $draft->{body} = <metadata; while (my ($title, $value) = each %{$details}) { $draft->{body} .= " - " . $title . ": " . $value . "\n" if $value; } $draft->{body} .= <$_ } qw/ branchname branchaddress1 branchaddress2 branchaddress3 branchzip branchcity branchstate branchcountry branchphone branchemail /; my $address = ""; foreach my $line ( @address ) { $address .= $line . "\n" if $line; } $draft->{body} .= $address; my $partners = Koha::Patrons->search({ categorycode => $self->_config->partner_code }); return { error => 0, status => '', message => '', method => 'generic_confirm', stage => 'draft', value => { draft => $draft, partners => $partners, } }; } elsif ( 'draft' eq $params->{stage} ) { # Create the to header my $to = $params->{partners}; if ( defined $to ) { $to =~ s/^\x00//; # Strip leading NULLs $to =~ s/\x00/; /; # Replace others with '; ' } Koha::Exceptions::Ill::NoTargetEmail->throw( "No target email addresses found. Either select at least one partner or check your ILL partner library records.") if ( !$to ); # Create the from, replyto and sender headers my $from = $branch->branchemail; my $replyto = $branch->branchreplyto || $from; Koha::Exceptions::Ill::NoLibraryEmail->throw( "Your library has no usable email address. Please set it.") if ( !$from ); # Create the email my $message = Koha::Email->new; my %mail = $message->create_message_headers( { to => $to, from => $from, replyto => $replyto, subject => Encode::encode( "utf8", $params->{subject} ), message => Encode::encode( "utf8", $params->{body} ), contenttype => 'text/plain', } ); # Send it my $result = sendmail(%mail); if ( $result ) { $self->status("GENREQ")->store; return { error => 0, status => '', message => '', method => 'generic_confirm', stage => 'commit', next => 'illview', }; } else { return { error => 1, status => 'email_failed', message => $Mail::Sendmail::error, method => 'generic_confirm', stage => 'draft', }; } } else { die "Unknown stage, should not have happened." } } =head3 id_prefix my $prefix = $record->id_prefix; Return the prefix appropriate for the current Illrequest as derived from the borrower and branch associated with this request's Status, and the config file. =cut sub id_prefix { my ( $self ) = @_; my $prefix = $self->getPrefix( { branch => $self->branchcode, } ); $prefix .= "-" if ( $prefix ); return $prefix; } =head3 _censor my $params = $illRequest->_censor($params); Return $params, modified to reflect our censorship requirements. =cut sub _censor { my ( $self, $params ) = @_; my $censorship = $self->_config->censorship; $params->{censor_notes_staff} = $censorship->{censor_notes_staff} if ( $params->{opac} ); $params->{display_reply_date} = ( $censorship->{censor_reply_date} ) ? 0 : 1; return $params; } =head3 TO_JSON $json = $illrequest->TO_JSON Overloaded I method that takes care of inserting calculated values into the unblessed representation of the object. TODO: This method does nothing and is not called anywhere. However, bug 74325 touches it, so keeping this for now until both this and bug 74325 are merged, at which point we can sort it out and remove it completely =cut sub TO_JSON { my ( $self, $embed ) = @_; my $object = $self->SUPER::TO_JSON(); return $object; } =head2 Internal methods =head3 _type =cut sub _type { return 'Illrequest'; } =head1 AUTHOR Alex Sassmannshausen =cut 1;