Koha/Z3950Responder/Session.pm

   1 package Koha::Z3950Responder::Session;
   2
   3 # Copyright ByWater Solutions 2016
   4 #
   5 # This file is part of Koha.
   6 #
   7 # Koha is free software; you can redistribute it and/or modify it
   8 # under the terms of the GNU General Public License as published by
   9 # the Free Software Foundation; either version 3 of the License, or
  10 # (at your option) any later version.
  11 #
  12 # Koha is distributed in the hope that it will be useful, but
  13 # WITHOUT ANY WARRANTY; without even the implied warranty of
  14 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  15 # GNU General Public License for more details.
  16 #
  17 # You should have received a copy of the GNU General Public License
  18 # along with Koha; if not, see <http://www.gnu.org/licenses>.
  19
  20 use Modern::Perl;
  21
  22 use C4::Context;
  23 use C4::Reserves qw( GetReserveStatus );
  24 use C4::Search qw( new_record_from_zebra );
  25
  26 use Koha::Items;
  27 use Koha::Logger;
  28
  29 =head1 NAME
  30
  31 Koha::Z3950Responder::Session
  32
  33 =head1 SYNOPSIS
  34
  35 An abstract class where backend-specific session modules are derived from.
  36 Z3950Responder creates one of the child classes depending on the SearchEngine
  37 preference.
  38
  39 =head1 DESCRIPTION
  40
  41 This class contains common functions for handling searching for and fetching
  42 of records. It can optionally add item status information to the returned
  43 records. The backend-specific abstract methods need to be implemented in a
  44 child class.
  45
  46 =head2 CONSTANTS
  47
  48 OIDs and diagnostic codes used in Z39.50
  49
  50 =cut
  51
  52 use constant {
  53     UNIMARC_OID => '1.2.840.10003.5.1',
  54     USMARC_OID => '1.2.840.10003.5.10',
  55     MARCXML_OID => '1.2.840.10003.5.109.10'
  56 };
  57
  58 use constant {
  59     ERR_TEMPORARY_ERROR => 2,
  60     ERR_PRESENT_OUT_OF_RANGE => 13,
  61     ERR_RECORD_TOO_LARGE => 16,
  62     ERR_NO_SUCH_RESULTSET => 30,
  63     ERR_SEARCH_FAILED => 125,
  64     ERR_SYNTAX_UNSUPPORTED => 239,
  65     ERR_DB_DOES_NOT_EXIST => 235,
  66 };
  67
  68 =head1 FUNCTIONS
  69
  70 =head2 INSTANCE METHODS
  71
  72 =head3 new
  73
  74     my $session = $self->new({
  75         server => $z3950responder,
  76         peer => 'PEER NAME'
  77     });
  78
  79 Instantiate a Session
  80
  81 =cut
  82
  83 sub new {
  84     my ( $class, $args ) = @_;
  85
  86     my $self = bless( {
  87         %$args,
  88         logger => Koha::Logger->get({ interface => 'z3950' }),
  89         resultsets => {},
  90     }, $class );
  91
  92     if ( $self->{server}->{debug} ) {
  93         $self->{logger}->debug_to_screen();
  94     }
  95
  96     $self->log_info('connected');
  97
  98     return $self;
  99 }
 100
 101 =head3 search_handler
 102
 103     Callback that is called when a new search is performed
 104
 105 Calls C<start_search> for backend-specific retrieval logic
 106
 107 =cut
 108
 109 sub search_handler {
 110     my ( $self, $args ) = @_;
 111
 112     my $database = $args->{DATABASES}->[0];
 113
 114     if ( $database ne $Koha::SearchEngine::BIBLIOS_INDEX && $database ne $Koha::SearchEngine::AUTHORITIES_INDEX ) {
 115         $self->set_error( $args, $self->ERR_DB_DOES_NOT_EXIST, 'No such database' );
 116         return;
 117     }
 118
 119     my $query = $args->{QUERY};
 120     $self->log_info("received search for '$query', (RS $args->{SETNAME})");
 121
 122     my ($resultset, $hits) = $self->start_search( $args, $self->{server}->{num_to_prefetch} );
 123     return unless $resultset;
 124
 125     $args->{HITS} = $hits;
 126     $self->{resultsets}->{ $args->{SETNAME} } = $resultset;
 127 }
 128
 129 =head3 fetch_handler
 130
 131     Callback that is called when records are requested
 132
 133 Calls C<fetch_record> for backend-specific retrieval logic
 134
 135 =cut
 136
 137 sub fetch_handler {
 138     my ( $self, $args ) = @_;
 139
 140     $self->log_debug("received fetch for RS $args->{SETNAME}, record $args->{OFFSET}");
 141
 142     my $server = $self->{server};
 143
 144     my $form_oid = $args->{REQ_FORM} // '';
 145     my $composition = $args->{COMP} // '';
 146     $self->log_debug("    form OID '$form_oid', composition '$composition'");
 147
 148     my $resultset = $self->{resultsets}->{ $args->{SETNAME} };
 149     # The offset comes across 1-indexed.
 150     my $offset = $args->{OFFSET} - 1;
 151
 152     return unless $self->check_fetch( $resultset, $args, $offset, 1 );
 153
 154     $args->{LAST} = 1 if ( $offset == $resultset->{hits} - 1 );
 155
 156     my $record = $self->fetch_record( $resultset, $args, $offset, $server->{num_to_prefetch} );
 157     return unless $record;
 158
 159     # Note that new_record_from_zebra is badly named and works also with Elasticsearch
 160     $record = C4::Search::new_record_from_zebra(
 161         $resultset->{database} eq 'biblios' ? 'biblioserver' : 'authorityserver',
 162         $record
 163     );
 164
 165     if ( $server->{add_item_status_subfield} ) {
 166         my $tag = $server->{item_tag};
 167
 168         foreach my $field ( $record->field($tag) ) {
 169             $self->add_item_status( $field );
 170         }
 171     }
 172
 173     if ( $form_oid eq $self->MARCXML_OID && $composition eq 'marcxml' ) {
 174         $args->{RECORD} = $record->as_xml_record();
 175     } elsif ( ( $form_oid eq $self->USMARC_OID || $form_oid eq $self->UNIMARC_OID ) && ( !$composition || $composition eq 'F' ) ) {
 176         $args->{RECORD} = $record->as_usmarc();
 177     } else {
 178         $self->set_error( $args, $self->ERR_SYNTAX_UNSUPPORTED, "Unsupported syntax/composition $form_oid/$composition" );
 179         return;
 180     }
 181 }
 182
 183 =head3 close_handler
 184
 185 Callback that is called when a session is terminated
 186
 187 =cut
 188
 189 sub close_handler {
 190     my ( $self, $args ) = @_;
 191
 192     # Override in a child class to add functionality
 193 }
 194
 195 =head3 start_search
 196
 197     my ($resultset, $hits) = $self->_start_search( $args, $self->{server}->{num_to_prefetch} );
 198
 199 A backend-specific method for starting a new search
 200
 201 =cut
 202
 203 sub start_search {
 204     die('Abstract method');
 205 }
 206
 207 =head3 check_fetch
 208
 209     $self->check_fetch($resultset, $args, $offset, $num_records);
 210
 211 Check that the fetch request parameters are within bounds of the result set.
 212
 213 =cut
 214
 215 sub check_fetch {
 216     my ( $self, $resultset, $args, $offset, $num_records ) = @_;
 217
 218     if ( !defined( $resultset ) ) {
 219         $self->set_error( $args, ERR_NO_SUCH_RESULTSET, 'No such resultset' );
 220         return 0;
 221     }
 222
 223     if ( $offset < 0 || $offset + $num_records > $resultset->{hits} )  {
 224         $self->set_error( $args, ERR_PRESENT_OUT_OF_RANGE, 'Present request out of range' );
 225         return 0;
 226     }
 227
 228     return 1;
 229 }
 230
 231 =head3 fetch_record
 232
 233     my $record = $self->_fetch_record( $resultset, $args, $offset, $server->{num_to_prefetch} );
 234
 235 A backend-specific method for fetching a record
 236
 237 =cut
 238
 239 sub fetch_record {
 240     die('Abstract method');
 241 }
 242
 243 =head3 add_item_status
 244
 245     $self->add_item_status( $field );
 246
 247 Add item status to the given field
 248
 249 =cut
 250
 251 sub add_item_status {
 252     my ( $self, $field ) = @_;
 253
 254     my $server = $self->{server};
 255
 256     my $itemnumber_subfield = $server->{itemnumber_subfield};
 257     my $add_subfield = $server->{add_item_status_subfield};
 258     my $status_strings = $server->{status_strings};
 259
 260     my $itemnumber = $field->subfield($itemnumber_subfield);
 261     next unless $itemnumber;
 262
 263     my $item = Koha::Items->find( $itemnumber );
 264     return unless $item;
 265
 266     my @statuses;
 267
 268     if ( $item->onloan() ) {
 269         push @statuses, $status_strings->{CHECKED_OUT};
 270     }
 271
 272     if ( $item->itemlost() ) {
 273         push @statuses, $status_strings->{LOST};
 274     }
 275
 276     if ( $item->notforloan() ) {
 277         push @statuses, $status_strings->{NOT_FOR_LOAN};
 278     }
 279
 280     if ( $item->damaged() ) {
 281         push @statuses, $status_strings->{DAMAGED};
 282     }
 283
 284     if ( $item->withdrawn() ) {
 285         push @statuses, $status_strings->{WITHDRAWN};
 286     }
 287
 288     if ( my $transfer = $item->get_transfer ) {
 289         push @statuses, $status_strings->{IN_TRANSIT} if $transfer->in_transit;
 290     }
 291
 292     if ( GetReserveStatus( $itemnumber ) ne '' ) {
 293         push @statuses, $status_strings->{ON_HOLD};
 294     }
 295
 296     if ( $server->{add_status_multi_subfield} ) {
 297         $field->add_subfields( map { ( $add_subfield, $_ ) } ( @statuses ? @statuses : $status_strings->{AVAILABLE} ) );
 298     } else {
 299         $field->add_subfields( $add_subfield, @statuses ? join( ', ', @statuses ) : $status_strings->{AVAILABLE} );
 300     }
 301 }
 302
 303
 304 =head3 log_debug
 305
 306     $self->log_debug('Message');
 307
 308 Output a debug message
 309
 310 =cut
 311
 312 sub log_debug {
 313     my ( $self, $msg ) = @_;
 314     $self->{logger}->debug("[$self->{peer}] $msg");
 315 }
 316
 317 =head3 log_info
 318
 319     $self->log_info('Message');
 320
 321 Output an info message
 322
 323 =cut
 324
 325 sub log_info {
 326     my ( $self, $msg ) = @_;
 327     $self->{logger}->info("[$self->{peer}] $msg");
 328 }
 329
 330 =head3 log_error
 331
 332     $self->log_error('Message');
 333
 334 Output an error message
 335
 336 =cut
 337
 338 sub log_error {
 339     my ( $self, $msg ) = @_;
 340     $self->{logger}->error("[$self->{peer}] $msg");
 341 }
 342
 343 =head3 set_error
 344
 345     $self->set_error($args, $self->ERR_SEARCH_FAILED, 'Backend connection failed' );
 346
 347 Set and log an error code and diagnostic message to be returned to the client
 348
 349 =cut
 350
 351 sub set_error {
 352     my ( $self, $args, $code, $msg ) = @_;
 353
 354     ( $args->{ERR_CODE}, $args->{ERR_STR} ) = ( $code, $msg );
 355
 356     $self->log_error("    returning error $code: $msg");
 357 }
 358
 359 1;