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

(-)a/C4/Installer/PerlDependencies.pm (+10 lines)
Lines 857-862 our $PERL_DEPS = { Link Here
857
        'required' => '0',
857
        'required' => '0',
858
        'min_ver'  => '0.07',
858
        'min_ver'  => '0.07',
859
    },
859
    },
860
    'Path::Tiny' => {
861
        usage => 'core',
862
        required => 1,
863
        min_ver => '0.058',
864
    },
865
    'Net::Z3950::SimpleServer' => {
866
        'usage'    => 'Z39.50 responder',
867
        'required' => '0',
868
        'min_ver'  => '1.15',
869
    },
860
};
870
};
861
871
862
1;
872
1;
(-)a/Koha/Logger.pm (+24 lines)
Lines 181-186 sub _recheck_logfile { # recheck saved logfile when logging message Link Here
181
    return -w $log;
181
    return -w $log;
182
}
182
}
183
183
184
=head2 debug_to_screen
185
186
Adds a new appender for the given logger that will log all DEBUG-and-higher messages to stderr.
187
Useful for daemons.
188
189
=cut
190
191
sub debug_to_screen {
192
    my $self = shift;
193
194
    return unless ( $self->{logger} );
195
196
    my $appender = Log::Log4perl::Appender->new(
197
        'Log::Log4perl::Appender::Screen',
198
        stderr => 1,
199
        utf8 => 1,
200
        name => 'debug_to_screen' # We need a specific name to prevent duplicates
201
    );
202
203
    $appender->threshold( $Log::Log4perl::DEBUG );
204
    $self->{logger}->add_appender( $appender );
205
    $self->{logger}->level( $Log::Log4perl::DEBUG );
206
}
207
184
=head1 AUTHOR
208
=head1 AUTHOR
185
209
186
Kyle M Hall, E<lt>kyle@bywatersolutions.comE<gt>
210
Kyle M Hall, E<lt>kyle@bywatersolutions.comE<gt>
(-)a/Koha/Z3950Responder.pm (+133 lines)
Line 0 Link Here
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 Koha;
28
use Koha::Z3950Responder::Session;
29
30
use Net::Z3950::SimpleServer;
31
32
sub new {
33
    my ( $class, $config ) = @_;
34
35
    my ($item_tag, $itemnumber_subfield) = GetMarcFromKohaField( "items.itemnumber", '' );
36
37
    # We hardcode the strings for English so SOMETHING will work if the authorized value doesn't exist.
38
    my $status_strings = {
39
        AVAILABLE => 'Available',
40
        CHECKED_OUT => 'Checked Out',
41
        LOST => 'Lost',
42
        NOT_FOR_LOAN => 'Not for Loan',
43
        DAMAGED => 'Damaged',
44
        WITHDRAWN => 'Withdrawn',
45
        IN_TRANSIT => 'In Transit',
46
        ON_HOLD => 'On Hold',
47
    };
48
49
    foreach my $val ( @{ GetAuthorisedValues( 'Z3950_STATUS' ) } ) {
50
        $status_strings->{ $val->{authorised_value} } = $val->{lib};
51
    }
52
53
    my $self = {
54
        %$config,
55
        item_tag => $item_tag,
56
        itemnumber_subfield => $itemnumber_subfield,
57
        status_strings => $status_strings,
58
    };
59
60
    # Turn off Yaz's built-in logging (can be turned back on if desired).
61
    unshift @{ $self->{yaz_options} }, '-v', 'none';
62
63
    # If requested, turn on debugging.
64
    if ( $self->{debug} ) {
65
        # Turn on single-process mode.
66
        unshift @{ $self->{yaz_options} }, '-S';
67
    }
68
69
    $self->{server} = Net::Z3950::SimpleServer->new(
70
        INIT => sub { $self->init_handler(@_) },
71
        SEARCH => sub { $self->search_handler(@_) },
72
        PRESENT => sub { $self->present_handler(@_) },
73
        FETCH => sub { $self->fetch_handler(@_) },
74
        CLOSE => sub { $self->close_handler(@_) },
75
    );
76
77
    return bless( $self, $class );
78
}
79
80
sub start {
81
    my ( $self ) = @_;
82
83
    $self->{server}->launch_server( 'Koha::Z3950Responder', @{ $self->{yaz_options} } )
84
}
85
86
# The rest of these methods are SimpleServer callbacks bound to this Z3950Responder object. It's
87
# worth noting that these callbacks don't return anything; they both receive and return data in the
88
# $args hashref.
89
90
sub init_handler {
91
    # Called when the client first connects.
92
    my ( $self, $args ) = @_;
93
94
    # This holds all of the per-connection state.
95
    my $session = Koha::Z3950Responder::Session->new({
96
        server => $self,
97
        peer => $args->{PEER_NAME},
98
    });
99
100
    $args->{HANDLE} = $session;
101
102
    $args->{IMP_NAME} = "Koha";
103
    $args->{IMP_VER} = Koha::version;
104
}
105
106
sub search_handler {
107
    # Called when search is first sent.
108
    my ( $self, $args ) = @_;
109
110
    $args->{HANDLE}->search_handler($args);
111
}
112
113
sub present_handler {
114
    # Called when a set of records is requested.
115
    my ( $self, $args ) = @_;
116
117
    $args->{HANDLE}->present_handler($args);
118
}
119
120
sub fetch_handler {
121
    # Called when a given record is requested.
122
    my ( $self, $args ) = @_;
123
124
    $args->{HANDLE}->fetch_handler( $args );
125
}
126
127
sub close_handler {
128
    my ( $self, $args ) = @_;
129
130
    $args->{HANDLE}->close_handler( $args );
131
}
132
133
1;
(-)a/Koha/Z3950Responder/Session.pm (+330 lines)
Line 0 Link Here
1
#!/usr/bin/perl
2
3
package Koha::Z3950Responder::Session;
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::Circulation qw( GetTransfers );
25
use C4::Context;
26
use C4::Items qw( GetItem );
27
use C4::Reserves qw( GetReserveStatus );
28
use C4::Search qw();
29
use Koha::Logger;
30
31
use ZOOM;
32
33
use constant {
34
    UNIMARC_OID => '1.2.840.10003.5.1',
35
    USMARC_OID => '1.2.840.10003.5.10',
36
    MARCXML_OID => '1.2.840.10003.5.109.10'
37
};
38
39
use constant {
40
    ERR_TEMPORARY_ERROR => 2,
41
    ERR_PRESENT_OUT_OF_RANGE => 13,
42
    ERR_RECORD_TOO_LARGE => 16,
43
    ERR_NO_SUCH_RESULTSET => 30,
44
    ERR_SYNTAX_UNSUPPORTED => 230,
45
    ERR_DB_DOES_NOT_EXIST => 235,
46
};
47
48
sub new {
49
    my ( $class, $args ) = @_;
50
51
    my $self = bless( {
52
        %$args,
53
        logger => Koha::Logger->get({ interface => 'z3950' }),
54
        resultsets => {},
55
    }, $class );
56
57
    if ( $self->{server}->{debug} ) {
58
        $self->{logger}->debug_to_screen();
59
    }
60
61
    $self->_log_info("connected");
62
63
    return $self;
64
}
65
66
sub _log_debug {
67
    my ( $self, $msg ) = @_;
68
    $self->{logger}->debug("[$self->{peer}] $msg");
69
}
70
71
sub _log_info {
72
    my ( $self, $msg ) = @_;
73
    $self->{logger}->info("[$self->{peer}] $msg");
74
}
75
76
sub _log_error {
77
    my ( $self, $msg ) = @_;
78
    $self->{logger}->error("[$self->{peer}] $msg");
79
}
80
81
sub _set_error {
82
    my ( $self, $args, $code, $msg ) = @_;
83
    ( $args->{ERR_CODE}, $args->{ERR_STR} ) = ( $code, $msg );
84
85
    $self->_log_error("    returning error $code: $msg");
86
}
87
88
sub _set_error_from_zoom {
89
    my ( $self, $args, $exception ) = @_;
90
91
    $self->_set_error( $args, ERR_TEMPORARY_ERROR, 'Cannot connect to upstream server' );
92
    $self->_log_error(
93
        "Zebra upstream error: " .
94
        $exception->message() . " (" .
95
        $exception->code() . ") " .
96
        ( $exception->addinfo() // '' ) . " " .
97
        $exception->diagset()
98
    );
99
}
100
101
# This code originally went through C4::Search::getRecords, but had to use so many escape hatches
102
# that it was easier to directly connect to Zebra.
103
sub _start_search {
104
    my ( $self, $args, $in_retry ) = @_;
105
106
    my $database = $args->{DATABASES}->[0];
107
    my ( $connection, $results );
108
109
    eval {
110
        $connection = C4::Context->Zconn(
111
            # We're depending on the caller to have done some validation.
112
            $database eq 'biblios' ? 'biblioserver' : 'authorityserver',
113
            0 # No, no async, doesn't really help much for single-server searching
114
        );
115
116
        $results = $connection->search_pqf( $args->{QUERY} );
117
118
        $self->_log_debug('    retry successful') if ($in_retry);
119
    };
120
    if ($@) {
121
        die $@ if ( ref($@) ne 'ZOOM::Exception' );
122
123
        if ( $@->diagset() eq 'ZOOM' && $@->code() == 10004 && !$in_retry ) {
124
            $self->_log_debug('    upstream server lost connection, retrying');
125
            return $self->_start_search( $args, 1 );
126
        }
127
128
        _set_error_from_zoom( $args, $@ );
129
        $connection = undef;
130
    }
131
132
    return ( $connection, $results, $results ? $results->size() : -1 );
133
}
134
135
sub _check_fetch {
136
    my ( $self, $resultset, $args, $offset, $num_records ) = @_;
137
138
    if ( !defined( $resultset ) ) {
139
        $self->_set_error( $args, ERR_NO_SUCH_RESULTSET, 'No such resultset' );
140
        return 0;
141
    }
142
143
    if ( $offset + $num_records > $resultset->{hits} )  {
144
        $self->_set_error( $args, ERR_PRESENT_OUT_OF_RANGE, 'Fetch request out of range' );
145
        return 0;
146
    }
147
148
    return 1;
149
}
150
151
sub _fetch_record {
152
    my ( $self, $resultset, $args, $index, $num_to_prefetch ) = @_;
153
154
    my $record;
155
156
    eval {
157
        if ( !$resultset->{results}->record_immediate( $index ) ) {
158
            my $start = int( $index / $num_to_prefetch ) * $num_to_prefetch;
159
160
            if ( $start + $num_to_prefetch >= $resultset->{results}->size() ) {
161
                $num_to_prefetch = $resultset->{results}->size() - $start;
162
            }
163
164
            $self->_log_debug("    fetch uncached, fetching $num_to_prefetch records starting at $start");
165
166
            $resultset->{results}->records( $start, $num_to_prefetch, 0 );
167
        }
168
169
        $record = $resultset->{results}->record_immediate( $index )->raw();
170
    };
171
    if ($@) {
172
        die $@ if ( ref($@) ne 'ZOOM::Exception' );
173
        $self->_set_error_from_zoom( $args, $@ );
174
        return;
175
    } else {
176
        return $record;
177
    }
178
}
179
180
sub search_handler {
181
    # Called when search is first sent.
182
    my ( $self, $args ) = @_;
183
184
    my $database = $args->{DATABASES}->[0];
185
186
    if ( $database !~ /^(biblios|authorities)$/ ) {
187
        $self->_set_error( ERR_DB_DOES_NOT_EXIST, 'No such database' );
188
        return;
189
    }
190
191
    my $query = $args->{QUERY};
192
    $self->_log_info("received search for '$query', (RS $args->{SETNAME})");
193
194
    my ( $connection, $results, $num_hits ) = $self->_start_search( $args );
195
    return unless $connection;
196
197
    $args->{HITS} = $num_hits;
198
    my $resultset = $self->{resultsets}->{ $args->{SETNAME} } = {
199
        database => $database,
200
        connection => $connection,
201
        results => $results,
202
        query => $args->{QUERY},
203
        hits => $args->{HITS},
204
    };
205
}
206
207
sub present_handler {
208
    # Called when a set of records is requested.
209
    my ( $self, $args ) = @_;
210
211
    $self->_log_debug("received present for $args->{SETNAME}, $args->{START}+$args->{NUMBER}");
212
213
    my $resultset = $self->{resultsets}->{ $args->{SETNAME} };
214
    # The offset comes across 1-indexed.
215
    my $offset = $args->{START} - 1;
216
217
    return unless $self->_check_fetch( $resultset, $args, $offset, $args->{NUMBER} );
218
219
    # Ignore if request is only for one record; our own prefetching will probably do a better job.
220
    $self->_prefetch_records( $resultset, $args, $offset, $args->{NUMBER} ) if ( $args->{NUMBER} > 1 );
221
}
222
223
sub fetch_handler {
224
    # Called when a given record is requested.
225
    my ( $self, $args ) = @_;
226
    my $session = $args->{HANDLE};
227
    my $server = $self->{server};
228
229
    $self->_log_debug("received fetch for $args->{SETNAME}, record $args->{OFFSET}");
230
    my $form_oid = $args->{REQ_FORM} // '';
231
    my $composition = $args->{COMP} // '';
232
    $self->_log_debug("    form OID $form_oid, composition $composition");
233
234
    my $resultset = $session->{resultsets}->{ $args->{SETNAME} };
235
    # The offset comes across 1-indexed.
236
    my $offset = $args->{OFFSET} - 1;
237
238
    return unless $self->_check_fetch( $resultset, $args, $offset, 1 );
239
240
    $args->{LAST} = 1 if ( $offset == $resultset->{hits} - 1 );
241
242
    my $record = $self->_fetch_record( $resultset, $args, $offset, $server->{num_to_prefetch} );
243
    return unless $record;
244
245
    $record = C4::Search::new_record_from_zebra(
246
        $resultset->{database} eq 'biblios' ? 'biblioserver' : 'authorityserver',
247
        $record
248
    );
249
250
    if ( $server->{add_item_status_subfield} ) {
251
        my $tag = $server->{item_tag};
252
253
        foreach my $field ( $record->field($tag) ) {
254
            $self->add_item_status( $field );
255
        }
256
    }
257
258
    if ( $form_oid eq MARCXML_OID && $composition eq 'marcxml' ) {
259
        $args->{RECORD} = $record->as_xml_record();
260
    } elsif ( ( $form_oid eq USMARC_OID || $form_oid eq UNIMARC_OID ) && ( !$composition || $composition eq 'F' ) ) {
261
        $args->{RECORD} = $record->as_usmarc();
262
    } else {
263
        $self->_set_error( $args, ERR_SYNTAX_UNSUPPORTED, "Unsupported syntax/composition $form_oid/$composition" );
264
        return;
265
    }
266
}
267
268
sub add_item_status {
269
    my ( $self, $field ) = @_;
270
271
    my $server = $self->{server};
272
273
    my $itemnumber_subfield = $server->{itemnumber_subfield};
274
    my $add_subfield = $server->{add_item_status_subfield};
275
    my $status_strings = $server->{status_strings};
276
277
    my $itemnumber = $field->subfield($itemnumber_subfield);
278
    next unless $itemnumber;
279
280
    my $item = GetItem( $itemnumber );
281
    return unless $item;
282
283
    my @statuses;
284
285
    if ( $item->{onloan} ) {
286
        push @statuses, $status_strings->{CHECKED_OUT};
287
    }
288
289
    if ( $item->{itemlost} ) {
290
        push @statuses, $status_strings->{LOST};
291
    }
292
293
    if ( $item->{notforloan} ) {
294
        push @statuses, $status_strings->{NOT_FOR_LOAN};
295
    }
296
297
    if ( $item->{damaged} ) {
298
        push @statuses, $status_strings->{DAMAGED};
299
    }
300
301
    if ( $item->{withdrawn} ) {
302
        push @statuses, $status_strings->{WITHDRAWN};
303
    }
304
305
    if ( scalar( GetTransfers( $itemnumber ) ) ) {
306
        push @statuses, $status_strings->{IN_TRANSIT};
307
    }
308
309
    if ( GetReserveStatus( $itemnumber ) ne '' ) {
310
        push @statuses, $status_strings->{ON_HOLD};
311
    }
312
313
    $field->delete_subfield( code => $itemnumber_subfield );
314
315
    if ( $server->{add_status_multi_subfield} ) {
316
        $field->add_subfields( map { ( $add_subfield, $_ ) } ( @statuses ? @statuses : $status_strings->{AVAILABLE} ) );
317
    } else {
318
        $field->add_subfields( $add_subfield, @statuses ? join( ', ', @statuses ) : $status_strings->{AVAILABLE} );
319
    }
320
}
321
322
sub close_handler {
323
    my ( $self, $args ) = @_;
324
325
    foreach my $resultset ( values %{ $self->{resultsets} } ) {
326
        $resultset->{results}->destroy();
327
    }
328
}
329
330
1;
(-)a/etc/log4perl.conf (+7 lines)
Lines 11-13 log4perl.appender.OPAC.filename=__LOG_DIR__/opac-error.log Link Here
11
log4perl.appender.OPAC.mode=append
11
log4perl.appender.OPAC.mode=append
12
log4perl.appender.OPAC.layout=PatternLayout
12
log4perl.appender.OPAC.layout=PatternLayout
13
log4perl.appender.OPAC.layout.ConversionPattern=[%d] [%p] %m %l %n
13
log4perl.appender.OPAC.layout.ConversionPattern=[%d] [%p] %m %l %n
14
15
log4perl.logger.z3950 = WARN, Z3950
16
log4perl.appender.Z3950=Log::Log4perl::Appender::File
17
log4perl.appender.Z3950.filename=__LOG_DIR__/logs/z3950-error.log
18
log4perl.appender.Z3950.mode=append
19
log4perl.appender.Z3950.layout=PatternLayout
20
log4perl.appender.Z3950.layout.ConversionPattern=[%d] [%p] %m %l %n
(-)a/misc/z3950_responder.pl (-1 / +153 lines)
Line 0 Link Here
0
- 
1
#!/usr/bin/perl
2
#
3
# Copyright ByWater Solutions 2015
4
#
5
# This file is part of Koha.
6
#
7
# Koha is free software; you can redistribute it and/or modify it under the
8
# terms of the GNU General Public License as published by the Free Software
9
# Foundation; either version 3 of the License, or (at your option) any later
10
# version.
11
#
12
# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
13
# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
14
# A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
15
#
16
# You should have received a copy of the GNU General Public License along
17
# with Koha; if not, write to the Free Software Foundation, Inc.,
18
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
19
20
use Modern::Perl;
21
22
use Carp;
23
use Getopt::Long;
24
use Pod::Usage;
25
26
use C4::Context;
27
use Koha::Z3950Responder;
28
29
=head1 SYNOPSIS
30
31
   z3950_responder.pl [-h|--help] [--man] [-a <pdufile>] [-v <loglevel>] [-l <logfile>] [-u <user>]
32
                      [-c <config>] [-t <minutes>] [-k <kilobytes>] [-d <daemon>] [-p <pidfile>]
33
                      [-C certfile] [-zKiDST1] [-m <time-format>] [-w <directory>] [--debug]
34
                      [--add-item-status=SUBFIELD] [--prefetch=NUM_RECORDS]
35
                      [<listener-addr>... ]
36
37
=head1 OPTIONS
38
39
=over 8
40
41
=item B<--help>
42
43
Prints a brief usage message and exits.
44
45
=item B<--man>
46
47
Displays manual page and exits.
48
49
=item B<--debug>
50
51
Turns on debug logging to the screen, and turns on single-process mode.
52
53
=item B<--add-item-status=SUBFIELD>
54
55
If given, adds item status information to the given subfield.
56
57
=item B<--add-status-multi-subfield>
58
59
With the above, instead of putting multiple item statuses in one subfield, adds a subfield for each
60
status string.
61
62
=item B<--prefetch=NUM_RECORDS>
63
64
Number of records to prefetch from Zebra. Defaults to 20.
65
66
=back
67
68
=head1 CONFIGURATION
69
70
The item status strings added by B<--add-item-status> can be configured with the B<Z3950_STATUS>
71
authorized value, using the following keys:
72
73
=over 4
74
75
=item AVAILABLE
76
77
=item CHECKED_OUT
78
79
=item LOST
80
81
=item NOT_FOR_LOAN
82
83
=item DAMAGED
84
85
=item WITHDRAWN
86
87
=item IN_TRANSIT
88
89
=item ON_HOLD
90
91
=back
92
93
=cut
94
95
my $add_item_status_subfield;
96
my $add_status_multi_subfield;
97
my $debug = 0;
98
my $help;
99
my $man;
100
my $prefetch = 20;
101
my @yaz_options;
102
103
sub add_yaz_option {
104
    my ( $opt_name, $opt_value ) = @_;
105
106
    push @yaz_options, "-$opt_name", "$opt_value";
107
}
108
109
GetOptions(
110
    '-h|help' => \$help,
111
    '--man' => \$man,
112
    '--debug' => \$debug,
113
    '--add-item-status=s' => \$add_item_status_subfield,
114
    '--add-status-multi-subfield' => \$add_status_multi_subfield,
115
    '--prefetch=i' => \$prefetch,
116
    # Pass through YAZ options.
117
    'a=s' => \&add_yaz_option,
118
    'v=s' => \&add_yaz_option,
119
    'l=s' => \&add_yaz_option,
120
    'u=s' => \&add_yaz_option,
121
    'c=s' => \&add_yaz_option,
122
    't=s' => \&add_yaz_option,
123
    'k=s' => \&add_yaz_option,
124
    'd=s' => \&add_yaz_option,
125
    'p=s' => \&add_yaz_option,
126
    'C=s' => \&add_yaz_option,
127
    'm=s' => \&add_yaz_option,
128
    'w=s' => \&add_yaz_option,
129
    'z' => \&add_yaz_option,
130
    'K' => \&add_yaz_option,
131
    'i' => \&add_yaz_option,
132
    'D' => \&add_yaz_option,
133
    'S' => \&add_yaz_option,
134
    'T' => \&add_yaz_option,
135
    '1' => \&add_yaz_option
136
) || pod2usage(2);
137
138
pod2usage(1) if $help;
139
pod2usage( -verbose => 2 ) if $man;
140
141
# Create and start the server.
142
143
die "This tool only works with Zebra" if C4::Context->preference('SearchEngine') ne 'Zebra';
144
145
my $z = Koha::Z3950Responder->new( {
146
    add_item_status_subfield => $add_item_status_subfield,
147
    add_status_multi_subfield => $add_status_multi_subfield,
148
    debug => $debug,
149
    num_to_prefetch => $prefetch,
150
    yaz_options => [ @yaz_options, @ARGV ],
151
} );
152
153
$z->start();

Return to bug 13937