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

(-)a/Koha/SuggestionEngine/Plugin/ExplodedTerms.pm (-19 / +17 lines)
Lines 32-41 subjects to subject searches. Link Here
32
=cut
32
=cut
33
33
34
use Modern::Perl;
34
use Modern::Perl;
35
use C4::Templates qw(gettemplate); # This is necessary for translatability
36
35
37
use base qw(Koha::SuggestionEngine::Base);
36
use base qw(Koha::SuggestionEngine::Base);
38
37
38
use Koha::I18N qw(__);
39
39
=head2 NAME
40
=head2 NAME
40
    my $name = $plugin->NAME;
41
    my $name = $plugin->NAME;
41
42
Lines 64-71 terms to the search. Link Here
64
=cut
65
=cut
65
66
66
sub get_suggestions {
67
sub get_suggestions {
67
    my $self  = shift;
68
    my ( $self, $param ) = @_;
68
    my $param = shift;
69
69
70
    my $search = $param->{'search'};
70
    my $search = $param->{'search'};
71
71
Lines 73-101 sub get_suggestions { Link Here
73
    $search =~ s/(su|su-br|su-na|su-rl)[:=](\w*)/OP!$2/g;
73
    $search =~ s/(su|su-br|su-na|su-rl)[:=](\w*)/OP!$2/g;
74
    return if ( $search =~ m/\w+[:=]\w+/ );
74
    return if ( $search =~ m/\w+[:=]\w+/ );
75
75
76
    my @indexes = (
76
    my $indexes_to_label = {
77
        'su-na',
77
        'su-na' => __('Search also for narrower subjects'),
78
        'su-br',
78
        'su-br' => __('Search also for broader subjects'),
79
        'su-rl'
79
        'su-rl' => __('Search also for related subjects'),
80
    );
80
    };
81
    my $cgi = CGI->new;
81
82
    my $template = C4::Templates::gettemplate('text/explodedterms.tt', 'opac', $cgi);
83
    my @results;
82
    my @results;
84
    foreach my $index (@indexes) {
83
    foreach my $index ( keys %{$indexes_to_label} ) {
85
        my $thissearch = $search;
84
        my $thissearch = $search;
86
        $thissearch = "$index:$thissearch"
85
        $thissearch = "$index:$thissearch"
87
          unless ( $thissearch =~ s/OP!/$index:/g );
86
          unless ( $thissearch =~ s/OP!/$index:/g );
88
        $template->{VARS}->{index} = $index;
87
        push @results, {
89
        my $label = $template->output;
90
        push @results,
91
        {
92
            'search'  => $thissearch,
88
            'search'  => $thissearch,
93
            relevance => 100,
89
            relevance => 100,
94
                # FIXME: it'd be nice to have some empirical measure of
90
95
                #        "relevance" in this case, but we don't.
91
            # FIXME: it'd be nice to have some empirical measure of
96
            label => $label
92
            #        "relevance" in this case, but we don't.
93
            label => $indexes_to_label->{$index}
97
        };
94
        };
98
    } return \@results;
95
    }
96
    return \@results;
99
}
97
}
100
98
101
1;
99
1;
(-)a/koha-tmpl/opac-tmpl/bootstrap/en/modules/text/explodedterms.tt (-9 lines)
Lines 1-9 Link Here
1
[% PROCESS 'i18n.inc' %]
2
[%- SWITCH index -%]
3
[%- CASE 'su-na' -%]
4
[% t('Search also for narrower subjects') | html %]
5
[%- CASE 'su-br' -%]
6
[% t('Search also for broader subjects') | html %]
7
[%- CASE 'su-rl' -%]
8
[% t('Search also for related subjects') | html %]
9
[%- END -%]
(-)a/t/db_dependent/SuggestionEngine_ExplodedTerms.t (-111 / +31 lines)
Lines 1-124 Link Here
1
#!/usr/bin/perl
1
#!/usr/bin/perl
2
2
3
use strict;
3
# This file is part of Koha
4
use warnings;
4
#
5
# Koha is free software; you can redistribute it and/or modify it
6
# under the terms of the GNU General Public License as published by
7
# the Free Software Foundation; either version 3 of the License, or
8
# (at your option) any later version.
9
#
10
# Koha is distributed in the hope that it will be useful, but
11
# WITHOUT ANY WARRANTY; without even the implied warranty of
12
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13
# GNU General Public License for more details.
14
#
15
# You should have received a copy of the GNU General Public License
16
# along with Koha; if not, see <http://www.gnu.org/licenses>.
5
17
6
use Cwd qw/abs_path/;
18
use Modern::Perl;
7
use File::Basename;
8
use File::Spec;
9
use Test::More;
10
use Test::MockModule;
11
use Test::Warn;
12
19
13
my $contextModule = Test::MockModule->new('C4::Context');
20
use Test::More tests => 5;
14
$contextModule->mock('preference', sub {
15
    return '';
16
});
17
$contextModule->mock('config', sub {
18
    my ($self,$key) = @_;
19
    if ($key eq 'opachtdocs') {
20
        return get_where() . '/koha-tmpl/opac-tmpl';
21
    } elsif ($key eq 'intrahtdocs') {
22
        return get_where() . '/koha-tmpl/intranet-tmpl';
23
    } else {
24
        return '';
25
    }
26
});
27
21
28
use_ok('Koha::SuggestionEngine');
22
use Koha::SuggestionEngine;
29
23
30
sub get_where {
24
my $suggestor = Koha::SuggestionEngine->new( { plugins => ['ExplodedTerms'] } );
31
    my $location = File::Spec->rel2abs(dirname(__FILE__));
25
is( ref($suggestor), 'Koha::SuggestionEngine', 'Created suggestion engine' );
32
    if ($location =~ /db_dependent/) {
33
        $location .= '/../..';
34
    }
35
    else {
36
        $location .= '/..';
37
    }
38
    return abs_path($location);
39
}
40
26
41
my $langModule;
27
my $result = $suggestor->get_suggestions( { search => 'Cookery' } );
42
if (! defined $ENV{KOHA_CONF}) {
43
    warning_like { $langModule = Test::MockModule->new('C4::Languages'); }
44
        qr /unable to locate Koha configuration file koha-conf.xml/,
45
        'Expected warning for unset $KOHA_CONF';
46
}
47
else {
48
    $langModule = Test::MockModule->new('C4::Languages');
49
}
50
$langModule->mock('regex_lang_subtags', sub {
51
    return {
52
        'extension' => undef,
53
        'script' => undef,
54
        'privateuse' => undef,
55
        'variant' => undef,
56
        'language' => 'en',
57
        'region' => undef,
58
        'rfc4646_subtag' => 'en'
59
    };
60
});
61
$langModule->mock('getTranslatedLanguages', sub {
62
   return [
63
       {
64
           'sublanguages_loop' => [
65
           {
66
               'script' => undef,
67
               'extension' => undef,
68
               'language' => 'en',
69
               'region' => undef,
70
               'region_description' => undef,
71
               'sublanguage_current' => 1,
72
               'privateuse' => undef,
73
               'variant' => undef,
74
               'variant_description' => undef,
75
               'script_description' => undef,
76
               'rfc4646_subtag' => 'en',
77
               'native_description' => 'English',
78
               'enabled' => 1
79
           },
80
           ],
81
           'plural' => 1,
82
           'language' => 'en',
83
           'current' => 1,
84
           'native_description' => 'English',
85
           'rfc4646_subtag' => 'en',
86
           'group_enabled' => 1
87
       }
88
   ];
89
});
90
my $tmplModule;
91
if (! defined $ENV{KOHA_CONF}) {
92
    warning_like { $tmplModule = Test::MockModule->new('C4::Templates'); }
93
        qr /unable to locate Koha configuration file koha-conf.xml/,
94
        'Expected warning for unset $KOHA_CONF';
95
}
96
else {
97
    $tmplModule = Test::MockModule->new('C4::Templates');
98
}
99
$tmplModule->mock('_get_template_file', sub {
100
    my ($tmplbase, $interface, $query) = @_;
101
    my $opactmpl = get_where() . '/koha-tmpl/opac-tmpl';
102
    return ($opactmpl, 'bootstrap', 'en', "$opactmpl/bootstrap/en/modules/$tmplbase");
103
});
104
28
105
my $suggestor = Koha::SuggestionEngine->new( { plugins => [ 'ExplodedTerms' ] } );
29
ok( ( grep { $_->{'search'} eq 'su-na:Cookery' } @$result ) && ( grep { $_->{'search'} eq 'su-br:Cookery' } @$result ) && ( grep { $_->{'search'} eq 'su-rl:Cookery' } @$result ),
106
is(ref($suggestor), 'Koha::SuggestionEngine', 'Created suggestion engine');
30
    "Suggested correct alternatives for keyword search 'Cookery'"
31
);
107
32
108
my $result = $suggestor->get_suggestions({search => 'Cookery'});
33
$result = $suggestor->get_suggestions( { search => 'su:Cookery' } );
109
34
110
ok((grep { $_->{'search'} eq 'su-na:Cookery' } @$result) && (grep { $_->{'search'} eq 'su-br:Cookery' } @$result) && (grep { $_->{'search'} eq 'su-rl:Cookery' } @$result), "Suggested correct alternatives for keyword search 'Cookery'");
35
ok( ( grep { $_->{'search'} eq 'su-na:Cookery' } @$result ) && ( grep { $_->{'search'} eq 'su-br:Cookery' } @$result ) && ( grep { $_->{'search'} eq 'su-rl:Cookery' } @$result ),
36
    "Suggested correct alternatives for subject search 'Cookery'"
37
);
111
38
112
$result = $suggestor->get_suggestions({search => 'su:Cookery'});
39
$result = $suggestor->get_suggestions( { search => 'nt:Cookery' } );
113
40
114
ok((grep { $_->{'search'} eq 'su-na:Cookery' } @$result) && (grep { $_->{'search'} eq 'su-br:Cookery' } @$result) && (grep { $_->{'search'} eq 'su-rl:Cookery' } @$result), "Suggested correct alternatives for subject search 'Cookery'");
41
is( scalar @$result, 0, "No suggestions for fielded search" );
115
42
116
$result = $suggestor->get_suggestions({search => 'nt:Cookery'});
43
$result = $suggestor->get_suggestions( { search => 'ccl=su:Cookery' } );
117
44
118
is(scalar @$result, 0, "No suggestions for fielded search");
45
is( scalar @$result, 0, "No suggestions for CCL search" );
119
120
$result = $suggestor->get_suggestions({search => 'ccl=su:Cookery'});
121
122
is(scalar @$result, 0, "No suggestions for CCL search");
123
124
done_testing();
125
- 

Return to bug 31069