"Fossies" - the Fresh Open Source Software Archive

Member "koha-19.11.15/Koha/Z3950Responder.pm" (23 Feb 2021, 5318 Bytes) of package /linux/misc/koha-19.11.15.tar.gz:


As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) Perl source code syntax highlighting (style: standard) with prefixed line numbers and code folding option. Alternatively you can here view or download the uninterpreted source code file. For more information about "Z3950Responder.pm" see the Fossies "Dox" file reference documentation and the last Fossies "Diffs" side-by-side code changes report: 20.11.01_vs_20.11.02.

    1 #!/usr/bin/perl
    2 
    3 package Koha::Z3950Responder;
    4 
    5 # Copyright ByWater Solutions 2016
    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 
   24 use C4::Biblio qw( GetMarcFromKohaField );
   25 use C4::Koha qw( GetAuthorisedValues );
   26 
   27 use Net::Z3950::SimpleServer;
   28 
   29 =head1 NAME
   30 
   31 Koha::Z3950Responder - Main class for interfacing with Net::Z3950::SimpleServer
   32 
   33 =head1 SYNOPSIS
   34 
   35     use Koha::Z3950Responder;
   36 
   37     my $z = Koha::Z3950Responder->new( {
   38         add_item_status_subfield => 1,
   39         add_status_multi_subfield => 1,
   40         debug => 0,
   41         num_to_prefetch => 20,
   42         config_dir => '/home/koha/etc',
   43         yaz_options => [ ],
   44     } );
   45 
   46     $z->start();
   47 
   48 =head1 DESCRIPTION
   49 
   50 A daemon class that interfaces with Net::Z3950::SimpleServer to provider Z39.50/SRU
   51 service. Uses a Session class for the actual functionality.
   52 
   53 =head1 METHODS
   54 
   55 =head2 INSTANCE METHODS
   56 
   57 =head3 new
   58 
   59     $self->new({
   60         add_item_status_subfield => 1
   61     });
   62 
   63 =cut
   64 
   65 sub new {
   66     my ( $class, $config ) = @_;
   67 
   68     my ($item_tag, $itemnumber_subfield) = GetMarcFromKohaField( "items.itemnumber" );
   69 
   70     # We hardcode the strings for English so SOMETHING will work if the authorized value doesn't exist.
   71     my $status_strings = {
   72         AVAILABLE => 'Available',
   73         CHECKED_OUT => 'Checked Out',
   74         LOST => 'Lost',
   75         NOT_FOR_LOAN => 'Not for Loan',
   76         DAMAGED => 'Damaged',
   77         WITHDRAWN => 'Withdrawn',
   78         IN_TRANSIT => 'In Transit',
   79         ON_HOLD => 'On Hold',
   80     };
   81 
   82     foreach my $val ( @{ GetAuthorisedValues( 'Z3950_STATUS' ) } ) {
   83         $status_strings->{ $val->{authorised_value} } = $val->{lib};
   84     }
   85 
   86     my $self = {
   87         %$config,
   88         item_tag => $item_tag,
   89         itemnumber_subfield => $itemnumber_subfield,
   90         status_strings => $status_strings,
   91     };
   92 
   93     # If requested, turn on debugging.
   94     if ( $self->{debug} ) {
   95         # Turn on single-process mode.
   96         unshift @{ $self->{yaz_options} }, '-S';
   97     } else {
   98         # Turn off Yaz's built-in logging apart from fatal errors (can be turned back on if desired).
   99         unshift @{ $self->{yaz_options} }, '-v', 'none,fatal';
  100     }
  101 
  102     # Set main config for SRU support and working directory
  103     if ( $self->{config_dir} ) {
  104         unshift @{ $self->{yaz_options} }, '-f', $self->{config_dir} . 'config.xml';
  105         unshift @{ $self->{yaz_options} }, '-w', $self->{config_dir};
  106     }
  107 
  108     # Set num to prefetch if not passed
  109     $self->{num_to_prefetch} //= 20;
  110 
  111     $self->{server} = Net::Z3950::SimpleServer->new(
  112         INIT => sub { $self->init_handler(@_) },
  113         SEARCH => sub { $self->search_handler(@_) },
  114         FETCH => sub { $self->fetch_handler(@_) },
  115         CLOSE => sub { $self->close_handler(@_) },
  116     );
  117 
  118     return bless( $self, $class );
  119 }
  120 
  121 =head3 start
  122 
  123     $z->start();
  124 
  125 Start the daemon and begin serving requests. Does not return unless initialization fails or a
  126 fatal error occurs.
  127 
  128 =cut
  129 
  130 sub start {
  131     my ( $self ) = @_;
  132 
  133     $self->{server}->launch_server( 'Koha::Z3950Responder', @{ $self->{yaz_options} } )
  134 }
  135 
  136 =head2 CALLBACKS
  137 
  138 These methods are SimpleServer callbacks bound to this Z3950Responder object.
  139 It's worth noting that these callbacks don't return anything; they both
  140 receive and return data in the $args hashref.
  141 
  142 =head3 init_handler
  143 
  144 Callback that is called when a new connection is initialized
  145 
  146 =cut
  147 
  148 sub init_handler {
  149     # Called when the client first connects.
  150     my ( $self, $args ) = @_;
  151 
  152     # This holds all of the per-connection state.
  153     my $session;
  154     if (C4::Context->preference('SearchEngine') eq 'Zebra') {
  155         use Koha::Z3950Responder::ZebraSession;
  156         $session = Koha::Z3950Responder::ZebraSession->new({
  157             server => $self,
  158             peer => $args->{PEER_NAME},
  159         });
  160     } else {
  161         use Koha::Z3950Responder::GenericSession;
  162         $session = Koha::Z3950Responder::GenericSession->new({
  163             server => $self,
  164             peer => $args->{PEER_NAME}
  165         });
  166     }
  167 
  168     $args->{HANDLE} = $session;
  169 
  170     $args->{IMP_NAME} = "Koha";
  171     $args->{IMP_VER} = Koha::version;
  172 }
  173 
  174 =head3 search_handler
  175 
  176 Callback that is called when a new search is performed
  177 
  178 =cut
  179 
  180 sub search_handler {
  181     my ( $self, $args ) = @_;
  182 
  183     $args->{HANDLE}->search_handler($args);
  184 }
  185 
  186 =head3 fetch_handler
  187 
  188 Callback that is called when records are requested
  189 
  190 =cut
  191 
  192 sub fetch_handler {
  193     my ( $self, $args ) = @_;
  194 
  195     $args->{HANDLE}->fetch_handler( $args );
  196 }
  197 
  198 =head3 close_handler
  199 
  200 Callback that is called when a session is terminated
  201 
  202 =cut
  203 
  204 sub close_handler {
  205     my ( $self, $args ) = @_;
  206 
  207     $args->{HANDLE}->close_handler( $args );
  208 }
  209 
  210 1;