File Coverage

blib/lib/LucyX/Remote/SearchServer.pm
Criterion Covered Total %
statement 22 91 24.1
branch 0 28 0.0
condition n/a
subroutine 8 19 42.1
pod 3 10 30.0
total 33 148 22.3


line stmt bran cond sub pod time code
1             # Licensed to the Apache Software Foundation (ASF) under one or more
2             # contributor license agreements. See the NOTICE file distributed with
3             # this work for additional information regarding copyright ownership.
4             # The ASF licenses this file to You under the Apache License, Version 2.0
5             # (the "License"); you may not use this file except in compliance with
6             # the License. You may obtain a copy of the License at
7             #
8             # http://www.apache.org/licenses/LICENSE-2.0
9             #
10             # Unless required by applicable law or agreed to in writing, software
11             # distributed under the License is distributed on an "AS IS" BASIS,
12             # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
13             # See the License for the specific language governing permissions and
14             # limitations under the License.
15              
16 3     3   1345 use strict;
  3         3  
  3         69  
17 3     3   9 use warnings;
  3         3  
  3         115  
18              
19             package LucyX::Remote::SearchServer;
20 3     3   101 BEGIN { our @ISA = qw( Clownfish::Obj ) }
21             our $VERSION = '0.006000_002';
22             $VERSION = eval $VERSION;
23 3     3   9 use Carp;
  3         2  
  3         139  
24 3     3   13 use Storable qw( nfreeze thaw );
  3         3  
  3         128  
25 3     3   9 use Scalar::Util qw( reftype );
  3         3  
  3         123  
26              
27             # Inside-out member vars.
28             our %searcher;
29              
30 3     3   9 use IO::Socket::INET;
  3         3  
  3         21  
31 3     3   2395 use IO::Select;
  3         3229  
  3         1874  
32              
33             sub new {
34 0     0 1   my ( $either, %args ) = @_;
35 0           my $searcher = delete $args{searcher};
36 0           my $self = $either->SUPER::new(%args);
37 0           $searcher{$$self} = $searcher;
38              
39 0           return $self;
40             }
41              
42             sub DESTROY {
43 0     0     my $self = shift;
44 0           delete $searcher{$$self};
45 0           $self->SUPER::DESTROY;
46             }
47              
48             my %dispatch = (
49             handshake => \&do_handshake,
50             terminate => \&do_terminate,
51             doc_max => \&do_doc_max,
52             doc_freq => \&do_doc_freq,
53             top_docs => \&do_top_docs,
54             fetch_doc => \&do_fetch_doc,
55             fetch_doc_vec => \&do_fetch_doc_vec,
56             );
57              
58             sub serve {
59 0     0 1   my ( $self, %args ) = @_;
60             # Establish a listening socket.
61 0           my $port = delete $args{port};
62 0 0         confess("Invalid port: $port") unless $port =~ /^\d+$/;
63 0           my $main_sock = IO::Socket::INET->new(
64             LocalPort => $port,
65             Proto => 'tcp',
66             Listen => SOMAXCONN,
67             Reuse => 1,
68             );
69 0 0         confess("No socket: $!") unless $main_sock;
70 0           my $read_set = IO::Select->new($main_sock);
71              
72 0           while ( my @ready = $read_set->can_read ) {
73 0           for my $readhandle (@ready) {
74             # If this is the main handle, we have a new client, so accept.
75 0 0         if ( $readhandle == $main_sock ) {
76 0           my $client_sock = $main_sock->accept;
77 0           $read_set->add($client_sock);
78             }
79             # Otherwise it's a client sock, so process the request.
80             else {
81 0           my $client_sock = $readhandle;
82 0           my $status = $self->serve_rpc($client_sock);
83              
84             # If "done", the client's closing.
85 0 0         if ( $status eq 'done' ) {
    0          
86 0           $read_set->remove($client_sock);
87 0           $client_sock->close;
88 0           next;
89             }
90             # Remote signal to close the server.
91             elsif ( $status eq 'terminate' ) {
92 0           my @all_handles = $read_set->handles;
93 0           $read_set->remove( \@all_handles );
94 0           $client_sock->close;
95 0           $main_sock->close;
96 0           return;
97             }
98             }
99             }
100             }
101             }
102              
103             sub serve_rpc {
104 0     0 1   my ( $self, $client_sock ) = @_;
105 0           my ( $check_val, $buf, $len );
106 0           $check_val = $client_sock->read( $buf, 4 );
107             # If read returns 0, socket has been closed cleanly at
108             # the other end.
109 0 0         return 'done' if $check_val == 0;
110 0 0         confess $! unless $check_val == 4;
111 0           $len = unpack( 'N', $buf );
112 0           $check_val = $client_sock->read( $buf, $len );
113 0 0         confess $! unless $check_val == $len;
114 0           my $args = eval { thaw($buf) };
  0            
115 0 0         confess $@ if $@;
116 0 0         confess "Not a hashref" unless reftype($args) eq 'HASH';
117 0           my $method = delete $args->{_action};
118              
119             # If "done", the client's closing.
120 0 0         return $method if $method eq 'done';
121              
122             # Process the method call.
123 0 0         $dispatch{$method}
124             or confess "ERROR: Bad method name: $method\n";
125 0           my $response = $dispatch{$method}->( $self, $args );
126 0           my $frozen = nfreeze($response);
127 0           my $packed_len = pack( 'N', length($frozen) );
128 0 0         print $client_sock "$packed_len$frozen"
129             or confess $!;
130              
131             # Remote signal to close the server.
132 0 0         return $method if $method eq 'terminate';
133              
134 0           return 'continue';
135             }
136              
137             sub do_handshake {
138 0     0 0   my ( $self, $args ) = @_;
139 0           my $retval = 1;
140 0           return { retval => $retval };
141             }
142              
143             sub do_terminate {
144 0     0 0   return { retval => 1 };
145             }
146              
147             sub do_doc_freq {
148 0     0 0   my ( $self, $args ) = @_;
149 0           return { retval => $searcher{$$self}->doc_freq(%$args) };
150             }
151              
152             sub do_top_docs {
153 0     0 0   my ( $self, $args ) = @_;
154 0           my $top_docs = $searcher{$$self}->top_docs(%$args);
155 0           return { retval => $top_docs };
156             }
157              
158             sub do_doc_max {
159 0     0 0   my ( $self, $args ) = @_;
160 0           my $doc_max = $searcher{$$self}->doc_max;
161 0           return { retval => $doc_max };
162             }
163              
164             sub do_fetch_doc {
165 0     0 0   my ( $self, $args ) = @_;
166 0           my $doc = $searcher{$$self}->fetch_doc( $args->{doc_id} );
167 0           return { retval => $doc };
168             }
169              
170             sub do_fetch_doc_vec {
171 0     0 0   my ( $self, $args ) = @_;
172 0           my $doc_vec = $searcher{$$self}->fetch_doc_vec( $args->{doc_id} );
173 0           return { retval => $doc_vec };
174             }
175              
176             1;
177              
178             __END__