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