View | Details | Raw Unified | Return to bug 17530
Collapse All | Expand All

(-)a/Koha/Biblio.pm (+26 lines)
Lines 99-104 sub can_article_request { Link Here
99
    return q{};
99
    return q{};
100
}
100
}
101
101
102
=head3 may_article_request
103
104
    Returns true if it is likely possible to make an article request for
105
    a given item type (or the default item type from biblioitems).
106
107
    # As class method:
108
    my $boolean = Koha::Biblio->may_article_request({ itemtype => 'BK' });
109
    # As instance method:
110
    my $boolean = Koha::Biblios->find($biblionumber)->may_article_request;
111
112
=cut
113
114
sub may_article_request {
115
    my ( $class_or_self, $params ) = @_;
116
    return q{} if !C4::Context->preference('ArticleRequests');
117
    my $itemtype = ref($class_or_self)
118
        ? $class_or_self->itemtype
119
        : $params->{itemtype};
120
    my $category = $params->{categorycode};
121
122
    my $guess = Koha::IssuingRules->guess_article_requestable_itemtypes({
123
        $category ? ( categorycode => $category ) : (),
124
    });
125
    return ( $guess->{ $itemtype } || $guess->{ '*' } ) ? 1 : q{};
126
}
127
102
=head3 article_request_type
128
=head3 article_request_type
103
129
104
my $type = $biblio->article_request_type( $borrower );
130
my $type = $biblio->article_request_type( $borrower );
(-)a/Koha/IssuingRules.pm (+59 lines)
Lines 121-126 sub get_onshelfholds_policy { Link Here
121
    return $issuing_rule ? $issuing_rule->onshelfholds : undef;
121
    return $issuing_rule ? $issuing_rule->onshelfholds : undef;
122
}
122
}
123
123
124
=head3 article_requestable_rules
125
126
    Return rules that allow article requests, optionally filtered by
127
    patron categorycode.
128
129
    Use with care; see guess_article_requestable_itemtypes.
130
131
=cut
132
133
sub article_requestable_rules {
134
    my ( $class_or_self, $params ) = @_;
135
    my $category = $params->{categorycode};
136
137
    return if !C4::Context->preference('ArticleRequests');
138
    return $class_or_self->search({
139
        $category ? ( categorycode => [ $category, '*' ] ) : (),
140
        article_requests => { '!=' => 'no' },
141
    });
142
}
143
144
=head3 guess_article_requestable_itemtypes
145
146
    Return item types in a hashref that are likely possible to be
147
    'article requested'. Constructed by an intelligent guess in the
148
    issuing rules (see article_requestable_rules).
149
150
    Optional parameters: categorycode.
151
152
    Note: the routine is used in opac-search to obtain a reasonable
153
    estimate within performance borders (not looking at all items but
154
    just using default itemtype). Also we are not looking at the
155
    branchcode here, since home or holding branch of the item is
156
    leading and branch may be unknown too (anonymous opac session).
157
158
=cut
159
160
our $last_article_requestable_guesses; # used during Plack life time
161
162
sub guess_article_requestable_itemtypes {
163
    my ( $class_or_self, $params ) = @_;
164
    my $category = $params->{categorycode};
165
    return {} if !C4::Context->preference('ArticleRequests');
166
167
    my $key = $category || '*';
168
    return $last_article_requestable_guesses->{$key}
169
        if $last_article_requestable_guesses && exists $last_article_requestable_guesses->{$key};
170
171
    my $res = {};
172
    my $rules = $class_or_self->article_requestable_rules({
173
        $category ? ( categorycode => $category ) : (),
174
    });
175
    return $res if !$rules;
176
    foreach my $rule ( $rules->as_list ) {
177
        $res->{ $rule->itemtype } = 1;
178
    }
179
    $last_article_requestable_guesses->{$key} = $res;
180
    return $res;
181
}
182
124
=head3 type
183
=head3 type
125
184
126
=cut
185
=cut
(-)a/t/db_dependent/ArticleRequests.t (-3 / +32 lines)
Lines 19-34 use Modern::Perl; Link Here
19
19
20
use POSIX qw(strftime);
20
use POSIX qw(strftime);
21
21
22
use Test::More tests => 55;
22
use Test::More tests => 56;
23
23
24
use t::lib::TestBuilder;
24
use t::lib::TestBuilder;
25
use t::lib::Mocks;
25
26
26
use Koha::Database;
27
use Koha::Database;
27
use Koha::Biblio;
28
use Koha::Biblio;
28
use Koha::Notice::Messages;
29
use Koha::Notice::Messages;
29
use Koha::Patron;
30
use Koha::Patron;
30
31
use Koha::Library::Group;
31
use t::lib::TestBuilder;
32
use Koha::IssuingRules;
32
33
33
BEGIN {
34
BEGIN {
34
    use_ok('Koha::ArticleRequest');
35
    use_ok('Koha::ArticleRequest');
Lines 219-224 subtest 'search_limited' => sub { Link Here
219
    is( Koha::ArticleRequests->search_limited->count, $nb_article_requests, 'Koha::ArticleRequests->search_limited should not return all article requests for restricted patron' );
220
    is( Koha::ArticleRequests->search_limited->count, $nb_article_requests, 'Koha::ArticleRequests->search_limited should not return all article requests for restricted patron' );
220
};
221
};
221
222
223
subtest 'may_article_request' => sub {
224
    plan tests => 6;
225
226
    # mocking
227
    t::lib::Mocks::mock_preference('ArticleRequests', 1);
228
    $Koha::IssuingRules::last_article_requestable_guesses = {
229
        '*'  => { 'CR' => 1 },
230
        'S'  => { '*'  => 1 },
231
        'PT' => { 'BK' => 1 },
232
    };
233
234
    # tests for class method call
235
    is( Koha::Biblio->may_article_request({ itemtype => 'CR' }), 1, 'SER/* should be true' );
236
    is( Koha::Biblio->may_article_request({ itemtype => 'CR', categorycode => 'S' }), 1, 'SER/S should be true' );
237
    is( Koha::Biblio->may_article_request({ itemtype => 'CR', categorycode => 'PT' }), '', 'SER/PT should be false' );
238
239
    # tests for instance method call
240
    my $builder = t::lib::TestBuilder->new;
241
    my $biblio = $builder->build_object({ class => 'Koha::Biblios' });
242
    my $biblioitem = $builder->build_object({ class => 'Koha::Biblioitems', value => { biblionumber => $biblio->biblionumber, itemtype => 'BK' }});
243
    is( $biblio->may_article_request, '', 'BK/* false' );
244
    is( $biblio->may_article_request({ categorycode => 'S' }), 1, 'BK/S true' );
245
    is( $biblio->may_article_request({ categorycode => 'PT' }), 1, 'BK/PT true' );
246
247
    # Cleanup
248
    $Koha::IssuingRules::last_article_requestable_guesses = undef;
249
};
250
222
$schema->storage->txn_rollback();
251
$schema->storage->txn_rollback();
223
252
224
sub set_logged_in_user {
253
sub set_logged_in_user {
(-)a/t/db_dependent/Koha/IssuingRules/guess_article_requestable_itemtypes.t (-1 / +67 lines)
Line 0 Link Here
0
- 
1
#!/usr/bin/perl
2
3
use Modern::Perl;
4
use Test::More tests => 1;
5
6
use t::lib::Mocks;
7
use t::lib::TestBuilder;
8
use Koha::Database;
9
use Koha::IssuingRules;
10
11
my $schema = Koha::Database->new->schema;
12
$schema->storage->txn_begin;
13
our $builder = t::lib::TestBuilder->new;
14
15
subtest 'guess_article_requestable_itemtypes' => sub {
16
    plan tests => 12;
17
18
    t::lib::Mocks::mock_preference('ArticleRequests', 1);
19
    Koha::IssuingRules->delete;
20
    my $itype1 = $builder->build_object({ class => 'Koha::ItemTypes' });
21
    my $itype2 = $builder->build_object({ class => 'Koha::ItemTypes' });
22
    my $catg1 = $builder->build_object({ class => 'Koha::Patron::Categories' });
23
    my $catg2 = $builder->build_object({ class => 'Koha::Patron::Categories' });
24
    my $rule1 = $builder->build_object({
25
        class => 'Koha::IssuingRules',
26
        value => {
27
            branchcode => 'MPL', # no worries: no FK
28
            categorycode => '*',
29
            itemtype => $itype1->itemtype,
30
            article_requests => 'bib_only',
31
        },
32
    });
33
    my $rule2 = $builder->build_object({
34
        class => 'Koha::IssuingRules',
35
        value => {
36
            branchcode => '*',
37
            categorycode => $catg1->categorycode,
38
            itemtype => $itype2->itemtype,
39
            article_requests => 'yes',
40
        },
41
    });
42
43
    my $res = Koha::IssuingRules->guess_article_requestable_itemtypes;
44
    is( $res->{'*'}, undef, 'Item type * seems not permitted' );
45
    is( $res->{$itype1->itemtype}, 1, 'Item type 1 seems permitted' );
46
    is( $res->{$itype2->itemtype}, 1, 'Item type 2 seems permitted' );
47
    $res = Koha::IssuingRules->guess_article_requestable_itemtypes({ categorycode => $catg2->categorycode });
48
    is( $res->{'*'}, undef, 'Item type * seems not permitted' );
49
    is( $res->{$itype1->itemtype}, 1, 'Item type 1 seems permitted' );
50
    is( $res->{$itype2->itemtype}, undef, 'Item type 2 seems not permitted' );
51
52
    # Change the rules
53
    $rule2->itemtype('*')->store;
54
    $Koha::IssuingRules::last_article_requestable_guesses = {};
55
    $res = Koha::IssuingRules->guess_article_requestable_itemtypes;
56
    is( $res->{'*'}, 1, 'Item type * seems permitted' );
57
    is( $res->{$itype1->itemtype}, 1, 'Item type 1 seems permitted' );
58
    is( $res->{$itype2->itemtype}, undef, 'Item type 2 seems not permitted' );
59
    $res = Koha::IssuingRules->guess_article_requestable_itemtypes({ categorycode => $catg2->categorycode });
60
    is( $res->{'*'}, undef, 'Item type * seems not permitted' );
61
    is( $res->{$itype1->itemtype}, 1, 'Item type 1 seems permitted' );
62
    is( $res->{$itype2->itemtype}, undef, 'Item type 2 seems not permitted' );
63
64
    $Koha::IssuingRules::last_article_requestable_guesses = {};
65
};
66
67
$schema->storage->txn_rollback;

Return to bug 17530