| Line 0
          
      
      
        Link Here | 
            
              |  |  | 1 | #!/usr/bin/perl | 
            
              | 2 |  | 
            
              | 3 | # This is a CGI script that handles the browse feature. | 
            
              | 4 |  | 
            
              | 5 | # Copyright 2015 Catalyst IT | 
            
              | 6 | # | 
            
              | 7 | # This file is part of Koha. | 
            
              | 8 | # | 
            
              | 9 | # Koha is free software; you can redistribute it and/or modify it under the | 
            
              | 10 | # terms of the GNU General Public License as published by the Free Software | 
            
              | 11 | # Foundation; either version 3 of the License, or (at your option) any later | 
            
              | 12 | # version. | 
            
              | 13 | # | 
            
              | 14 | # Koha is distributed in the hope that it will be useful, but WITHOUT ANY | 
            
              | 15 | # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR | 
            
              | 16 | # A PARTICULAR PURPOSE.  See the GNU General Public License for more details. | 
            
              | 17 | # | 
            
              | 18 | # You should have received a copy of the GNU General Public License along | 
            
              | 19 | # with Koha; if not, write to the Free Software Foundation, Inc., | 
            
              | 20 | # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. | 
            
              | 21 |  | 
            
              | 22 | use Modern::Perl; | 
            
              | 23 | use CGI qw( -utf8 :standard ); | 
            
              | 24 |  | 
            
              | 25 | use C4::Auth; | 
            
              | 26 | use C4::Context; | 
            
              | 27 |  | 
            
              | 28 | use Koha::ElasticSearch; | 
            
              | 29 | use Koha::SearchEngine::Elasticsearch::Browse; | 
            
              | 30 | use Koha::SearchEngine::Elasticsearch::QueryBuilder; | 
            
              | 31 | use Koha::SearchEngine::Elasticsearch::Search; | 
            
              | 32 |  | 
            
              | 33 | use JSON; | 
            
              | 34 | use Unicode::Collate; | 
            
              | 35 |  | 
            
              | 36 | my $query = new CGI; | 
            
              | 37 | binmode STDOUT, ':utf8'; | 
            
              | 38 |  | 
            
              | 39 | # This is the temporary entrance point to the API. Once bug #13799 is settled, | 
            
              | 40 | # it should be ported to using that. | 
            
              | 41 | my $api = $query->param('api'); | 
            
              | 42 |  | 
            
              | 43 | if ( !$api ) { | 
            
              | 44 |  | 
            
              | 45 |     # No parameters, so we just render the template. | 
            
              | 46 |  | 
            
              | 47 | } | 
            
              | 48 | elsif ( $api eq 'GetSuggestions' ) { | 
            
              | 49 |     my $fuzzie = $query->param('fuzziness'); | 
            
              | 50 |     my $prefix = $query->param('prefix'); | 
            
              | 51 |     my $field  = $query->param('field'); | 
            
              | 52 |  | 
            
              | 53 | # Under a persistant environment, we should probably not reinit this every time. | 
            
              | 54 |     my $browser = | 
            
              | 55 |       Koha::SearchEngine::Elasticsearch::Browse->new( { index => 'biblios' } ); | 
            
              | 56 |     my $res = $browser->browse( $prefix, $field, { fuzziness => $fuzzie } ); | 
            
              | 57 |     my $collator = Unicode::Collate->new(); | 
            
              | 58 |  | 
            
              | 59 |     # possible optimisation is to cache the collated values and do a straight | 
            
              | 60 |     # cmp. | 
            
              | 61 |     my @sorted = sort { $collator->cmp( $a->{text}, $b->{text} ) } @$res; | 
            
              | 62 |     print header( | 
            
              | 63 |         -type    => 'application/json', | 
            
              | 64 |         -charset => 'utf-8' | 
            
              | 65 |     ); | 
            
              | 66 |     print to_json( \@sorted ); | 
            
              | 67 | } | 
            
              | 68 | elsif ( $api eq 'GetResults' ) { | 
            
              | 69 |     my $term  = $query->param('term'); | 
            
              | 70 |     my $field = $query->param('field'); | 
            
              | 71 |  | 
            
              | 72 |     my $builder  = Koha::SearchEngine::Elasticsearch::QueryBuilder->new( { index => 'biblios' } ); | 
            
              | 73 |     my $searcher = Koha::SearchEngine::Elasticsearch::Search->new( | 
            
              | 74 |         { index => $Koha::ElasticSearch::BIBLIOS_INDEX } ); | 
            
              | 75 |  | 
            
              | 76 |     my $query = $builder->build_query( | 
            
              | 77 |         [ { term => $term, field => $field, exact => 1 } ] ); | 
            
              | 78 |     my $results = $searcher->search( $query, undef, 500 ); | 
            
              | 79 |     my @output = _filter_for_output( $results->{records} ); | 
            
              | 80 |     print header( | 
            
              | 81 |         -type    => 'application/json', | 
            
              | 82 |         -charset => 'utf-8' | 
            
              | 83 |     ); | 
            
              | 84 |     print to_json( \@output ); | 
            
              | 85 | } | 
            
              | 86 |  | 
            
              | 87 | # This is a temporary, MARC21-only thing that will grab titles, authors, | 
            
              | 88 | # and subjects. This should probably be done with some templatey gizmo | 
            
              | 89 | # in the future. | 
            
              | 90 | sub _filter_for_output { | 
            
              | 91 |     no warnings 'qw';    # it doesn't like the , in the qw | 
            
              | 92 |     my ($records) = @_; | 
            
              | 93 |  | 
            
              | 94 |     my @author_marc = qw(100,a 110,a 111,a 700,a 710,a 711,a); | 
            
              | 95 |     my @subjects_marc = | 
            
              | 96 |       qw(600 610 611 630 648 650 651); | 
            
              | 97 |     my @output; | 
            
              | 98 |     foreach my $rec (@$records) { | 
            
              | 99 |         my $marc = $rec->{marc}; | 
            
              | 100 |         my $title; | 
            
              | 101 |         { | 
            
              | 102 |             # we do an ugly hack to fix up a little bit of bad formatting. | 
            
              | 103 |             my ($t_a, $t_b, $t_c) = | 
            
              | 104 |             (( $marc->subfield( 245, 'a' ) // '' ), | 
            
              | 105 |              ( $marc->subfield( 245, 'b' ) // '' ), | 
            
              | 106 |              ( $marc->subfield( 245, 'c' ) // '' )); | 
            
              | 107 |             $t_a .= ' ' unless $t_a =~ / $/; | 
            
              | 108 |             $t_b .= ' ' unless $t_b =~ / $/; | 
            
              | 109 |             $title = $t_a . $t_b . $t_c; | 
            
              | 110 |         } | 
            
              | 111 |         my @authors; | 
            
              | 112 |         foreach my $m (@author_marc) { | 
            
              | 113 |             push @authors, ( $marc->subfield( split( ',', $m ) ) // () ); | 
            
              | 114 |         } | 
            
              | 115 |         my @subj_fields; | 
            
              | 116 |         foreach my $m (@subjects_marc) { | 
            
              | 117 |             # first collect all the fields | 
            
              | 118 |             push @subj_fields, $marc->field($m); | 
            
              | 119 |         } | 
            
              | 120 |         # Now grab the a and x from each field and reformat it | 
            
              | 121 |         my @subjects; | 
            
              | 122 |         foreach my $s (@subj_fields) { | 
            
              | 123 |             my @vals = (scalar($s->subfield('a')), $s->subfield('x')); | 
            
              | 124 |             next unless @vals; | 
            
              | 125 |             push @subjects, join( ' -- ', @vals ); | 
            
              | 126 |         } | 
            
              | 127 |         push @output, | 
            
              | 128 |           { | 
            
              | 129 |             id => $rec->{id}, | 
            
              | 130 |             title    => $title, | 
            
              | 131 |             authors  => \@authors, | 
            
              | 132 |             subjects => \@subjects, | 
            
              | 133 |           }; | 
            
              | 134 |     } | 
            
              | 135 |     return @output; | 
            
              | 136 | } |