Bug 21336: Introduce administrative lockout

[koha.git] / Koha / Illrequest.pm

package Koha::Illrequest;

# Copyright PTFS Europe 2016,2018
#
# 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 DateTime;

use Koha::Database;
use Koha::Email;
use Koha::Exceptions::Ill;
use Koha::Illcomments;
use Koha::Illrequestattributes;
use Koha::AuthorisedValue;
use Koha::Illrequest::Logger;
use Koha::Patron;
use Koha::AuthorisedValues;

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 statusalias

    my $statusalias = $request->statusalias;

Returns a request's status alias, as a Koha::AuthorisedValue instance
or implicit undef. This is distinct from status_alias, which only returns
the value in the status_alias column, this method returns the entire
AuthorisedValue object

=cut

sub statusalias {
    my ( $self ) = @_;
    return unless $self->status_alias;
    # We can't know which result is the right one if there are multiple
    # ILLSTATUS authorised values with the same authorised_value column value
    # so we just use the first
    return Koha::AuthorisedValues->search({
        branchcode => $self->branchcode,
        category => 'ILLSTATUS',
        authorised_value => $self->SUPER::status_alias
    })->next;
}

=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 logs

=cut

sub logs {
    my ( $self ) = @_;
    my $logger = Koha::Illrequest::Logger->new;
    return $logger->get_request_logs($self);
}

=head3 patron

=cut

sub patron {
    my ( $self ) = @_;
    return Koha::Patron->_new_from_dbic(
        scalar $self->_result->borrowernumber
    );
}

=head3 status_alias

    $Illrequest->status_alias(143);

Overloaded getter/setter for status_alias,
that only returns authorised values from the
correct category and records the fact that the status has changed

=cut

sub status_alias {
    my ($self, $new_status_alias) = @_;

    my $current_status_alias = $self->SUPER::status_alias;

    if ($new_status_alias) {
        # Keep a record of the previous status before we change it,
        # we might need it
        $self->{previous_status} = $current_status_alias ?
            $current_status_alias :
            scalar $self->status;
        # This is hackery to enable us to undefine
        # status_alias, since we need to have an overloaded
        # status_alias method to get us around the problem described
        # here:
        # https://bugs.koha-community.org/bugzilla3/show_bug.cgi?id=20581#c156
        # We need a way of accepting implied undef, so we can nullify
        # the status_alias column, when called from $self->status
        my $val = $new_status_alias eq "-1" ? undef : $new_status_alias;
        my $ret = $self->SUPER::status_alias($val);
        my $val_to_log = $val ? $new_status_alias : scalar $self->status;
        if ($ret) {
            my $logger = Koha::Illrequest::Logger->new;
            $logger->log_status_change({
                request => $self,
                value   => $val_to_log
            });
        } else {
            delete $self->{previous_status};
        }
        return $ret;
    }
    # We can't know which result is the right one if there are multiple
    # ILLSTATUS authorised values with the same authorised_value column value
    # so we just use the first
    my $alias = Koha::AuthorisedValues->search({
        branchcode => $self->branchcode,
        category => 'ILLSTATUS',
        authorised_value => $self->SUPER::status_alias
    })->next;
    if ($alias) {
        return $alias->authorised_value;
    } else {
        return;
    }
}

=head3 status

    $Illrequest->status('CANREQ');

Overloaded getter/setter for request status,
also nullifies status_alias and records the fact that the status has changed

=cut

sub status {
    my ( $self, $new_status) = @_;

    my $current_status = $self->SUPER::status;
    my $current_status_alias = $self->SUPER::status_alias;

    if ($new_status) {
        # Keep a record of the previous status before we change it,
        # we might need it
        $self->{previous_status} = $current_status_alias ?
            $current_status_alias :
            $current_status;
        my $ret = $self->SUPER::status($new_status)->store;
        if ($current_status_alias) {
            # This is hackery to enable us to undefine
            # status_alias, since we need to have an overloaded
            # status_alias method to get us around the problem described
            # here:
            # https://bugs.koha-community.org/bugzilla3/show_bug.cgi?id=20581#c156
            # We need a way of passing implied undef to nullify status_alias
            # so we pass -1, which is special cased in the overloaded setter
            $self->status_alias("-1");
        } else {
            my $logger = Koha::Illrequest::Logger->new;
            $logger->log_status_change({
                request => $self,
                value   => $new_status
            });
        }
        delete $self->{previous_status};
        return $ret;
    } else {
        return $current_status;
    }
}

=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,
        logger => Koha::Illrequest::Logger->new
    });
    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;
    # See if capability is defined in backend
    try {
        $capability = $self->_backend->capabilities($name);
    } catch {
        return 0;
    };
    # Try to invoke it
    if ( $capability && ref($capability) eq 'CODE' ) {
        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, $reduced ) = @_;
    my $backends = $self->_config->available_backends($reduced);
    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;
    $self->completed(DateTime->now)->store;
    return {
        error   => 0,
        status  => '',
        message => '',
        method  => 'mark_completed',
        stage   => 'commit',
        next    => 'illview',
    };
}

=head2 backend_migrate

Migrate a request from one backend to another.

=cut

sub backend_migrate {
    my ( $self, $params ) = @_;

    my $response = $self->_backend_capability('migrate',{
            request    => $self,
            other      => $params,
        });
    return $self->expandTemplate($response) if $response;
    return $response;
}

=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   => {
                    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 );

    ## Handle Unmediated ILLs

    # For the unmediated workflow we only need to delegate to our backend. If
    # that backend supports unmediateld_ill, it will do its thing and return a
    # proper response.  If it doesn't then _backend_capability returns 0, so
    # we keep the current result.
    if ( C4::Context->preference("ILLModuleUnmediated") && $permitted ) {
        my $unmediated_result = $self->_backend_capability(
            'unmediated_ill',
            $args
        );
        $result = $unmediated_result if $unmediated_result;
    }

    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} = <<EOF;
Dear Sir/Madam,

    We would like to request an interlibrary loan for a title matching the
following description:

EOF

        my $details = $self->metadata;
        while (my ($title, $value) = each %{$details}) {
            $draft->{body} .= "  - " . $title . ": " . $value . "\n"
                if $value;
        }
        $draft->{body} .= <<EOF;

Please let us know if you are able to supply this to us.

Kind Regards

EOF

        my @address = map { $branch->$_ }
            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;
            $self->_backend_capability(
                'set_requested_partners',
                {
                    request => $self,
                    to => $to
                }
            );
            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 store

    $Illrequest->store;

Overloaded I<store> method that, in addition to performing the 'store',
possibly records the fact that something happened

=cut

sub store {
    my ( $self, $attrs ) = @_;

    my $ret = $self->SUPER::store;

    $attrs->{log_origin} = 'core';

    if ($ret && defined $attrs) {
        my $logger = Koha::Illrequest::Logger->new;
        $logger->log_maybe({
            request => $self,
            attrs   => $attrs
        });
    }

    return $ret;
}

=head3 requested_partners

    my $partners_string = $illRequest->requested_partners;

Return the string representing the email addresses of the partners to
whom a request has been sent

=cut

sub requested_partners {
    my ( $self ) = @_;
    return $self->_backend_capability(
        'get_requested_partners',
        { request => $self }
    );
}

=head3 TO_JSON

    $json = $illrequest->TO_JSON

Overloaded I<TO_JSON> 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 <alex.sassmannshausen@ptfs-europe.com>
Andrew Isherwood <andrew.isherwood@ptfs-europe.com>

=cut

1;