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

(-)a/Koha/Biblio.pm (+26 lines)
Lines 169-174 sub can_be_transferred { Link Here
169
    return 0;
169
    return 0;
170
}
170
}
171
171
172
=head3 may_article_request
173
174
    Returns true if it is likely possible to make an article request for
175
    a given item type (or the default item type from biblioitems).
176
177
    # As class method:
178
    my $boolean = Koha::Biblio->may_article_request({ itemtype => 'BK' });
179
    # As instance method:
180
    my $boolean = Koha::Biblios->find($biblionumber)->may_article_request;
181
182
=cut
183
184
sub may_article_request {
185
    my ( $class_or_self, $params ) = @_;
186
    return q{} if !C4::Context->preference('ArticleRequests');
187
    my $itemtype = ref($class_or_self)
188
        ? $class_or_self->itemtype
189
        : $params->{itemtype};
190
    my $category = $params->{categorycode};
191
192
    my $guess = Koha::IssuingRules->guess_article_requestable_itemtypes({
193
        $category ? ( categorycode => $category ) : (),
194
    });
195
    return ( $guess->{ $itemtype // q{} } || $guess->{ '*' } ) ? 1 : q{};
196
}
197
172
=head3 article_request_type
198
=head3 article_request_type
173
199
174
my $type = $biblio->article_request_type( $borrower );
200
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 217-222 subtest 'search_limited' => sub { Link Here
217
    is( Koha::ArticleRequests->search_limited->count, 0, 'Koha::ArticleRequests->search_limited should not return all article requests for restricted patron' );
218
    is( Koha::ArticleRequests->search_limited->count, 0, 'Koha::ArticleRequests->search_limited should not return all article requests for restricted patron' );
218
};
219
};
219
220
221
subtest 'may_article_request' => sub {
222
    plan tests => 6;
223
224
    # mocking
225
    t::lib::Mocks::mock_preference('ArticleRequests', 1);
226
    $Koha::IssuingRules::last_article_requestable_guesses = {
227
        '*'  => { 'CR' => 1 },
228
        'S'  => { '*'  => 1 },
229
        'PT' => { 'BK' => 1 },
230
    };
231
232
    # tests for class method call
233
    is( Koha::Biblio->may_article_request({ itemtype => 'CR' }), 1, 'SER/* should be true' );
234
    is( Koha::Biblio->may_article_request({ itemtype => 'CR', categorycode => 'S' }), 1, 'SER/S should be true' );
235
    is( Koha::Biblio->may_article_request({ itemtype => 'CR', categorycode => 'PT' }), '', 'SER/PT should be false' );
236
237
    # tests for instance method call
238
    my $builder = t::lib::TestBuilder->new;
239
    my $biblio = $builder->build_object({ class => 'Koha::Biblios' });
240
    my $biblioitem = $builder->build_object({ class => 'Koha::Biblioitems', value => { biblionumber => $biblio->biblionumber, itemtype => 'BK' }});
241
    is( $biblio->may_article_request, '', 'BK/* false' );
242
    is( $biblio->may_article_request({ categorycode => 'S' }), 1, 'BK/S true' );
243
    is( $biblio->may_article_request({ categorycode => 'PT' }), 1, 'BK/PT true' );
244
245
    # Cleanup
246
    $Koha::IssuingRules::last_article_requestable_guesses = undef;
247
};
248
220
$schema->storage->txn_rollback();
249
$schema->storage->txn_rollback();
221
250
222
sub set_logged_in_user {
251
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