6 use Net::Z3950::SimpleServer;
20 my $max_records = 3; # XXX configure this
21 my $max_result_sets = 10;
31 $self->{HANDLE} = $session;
32 $self->{IMP_NAME} = "Biblio Z39.50";
33 $self->{IMP_VER} = "0.2";
34 $session->{SETS} = {};
40 diag "SearchHandle ",Dumper($self);
42 my $session = $self->{HANDLE};
43 my $rpn = $self->{RPN};
46 my $database = uc $self->{DATABASES}->[0];
47 my $module = $databases->{$database};
48 if ( ! defined $module ) {
49 $self->{ERR_CODE} = 108;
50 warn $self->{ERR_STR} = "$database NOT FOUND in available databases: " . join(" ", keys %$databases);
54 my $from = $module->new( $database );
56 diag "using $module for $database ", Dumper( $from );
58 eval { $query = $rpn->{query}->render( $from->usemap ); };
59 warn "ERROR: $@" if $@;
60 if ( $@ && ref($@) ) { ## Did someone/something report any errors?
61 $self->{ERR_CODE} = $@->{errcode};
62 $self->{ERR_STR} = $@->{errstr};
66 $query = decode('utf-8', $query); # FIXME Zoom encoding
68 diag "search for $query";
70 my $setname = $self->{SETNAME};
71 my $repl_set = $self->{REPL_SET};
72 diag "SETNAME $setname REPL_SET $repl_set";
74 unless ( $hits = $from->search( $query ) ) {
75 warn $self->{ERR_STR} = "no results for $query";
76 $self->{ERR_CODE} = 108;
79 diag "got $hits hits";
82 upper => $hits < $max_records ? $max_records : $hits,
85 results => [ undef ], # we don't use 0 element
86 database => $database,
88 my $sets = $session->{SETS};
90 if ( defined( $sets->{$setname} ) && !$repl_set ) {
91 $self->{ERR_CODE} = 21;
94 if ( scalar keys %$sets >= $max_result_sets ) {
95 $self->{ERR_CODE} = 112;
96 $self->{ERR_STR} = "Max number is $max_result_sets";
99 $sets->{$setname} = $rs;
100 $self->{HITS} = $session->{HITS} = $hits;
101 $session->{QUERY} = $query;
106 my $session = $self->{HANDLE};
107 my $setname = $self->{SETNAME};
108 my $req_form = $self->{REQ_FORM};
109 my $offset = $self->{OFFSET};
110 my $sets = $session->{SETS};
111 my $hits = $session->{HITS};
115 if ( !defined( $rs = $sets->{$setname} ) ) {
116 $self->{ERR_CODE} = 30;
119 if ( $offset > $hits ) {
120 $self->{ERR_CODE} = 13;
124 $self->{BASENAME} = $rs->{database};
127 $req_form eq Net::Z3950::OID::xml() ? 'xml' :
128 $req_form eq Net::Z3950::OID::unimarc() ? 'unimarc' :
129 $req_form eq Net::Z3950::OID::usmarc() ? 'marc' : # XXX usmarc -> marc
130 die "unknown format $req_form";
133 warn "ERROR: $req_form format not supported";
134 $self->{ERR_CODE} = 239; ## Unsupported record format
135 $self->{ERR_STR} = $req_form;
139 $self->{REP_FORM} = $req_form;
141 my $from = $rs->{from} || die "no from?";
142 # fetch records up to offset
143 while( $#{ $rs->{results} } < $offset ) {
144 push @{ $rs->{results} }, $from->next_marc;
145 warn "# rs result ", $#{ $rs->{results} },"\n";
148 my $id = $rs->{results}->[$offset] || die "no id for record $offset in ",Dumper( $rs->{results} );
150 my $path = 'marc/' . $rs->{database} . "/$id.$format";
152 warn "ERROR: $path not found";
153 ## Unsupported record format
154 $self->{ERR_CODE} = 239;
155 $self->{ERR_STR} = $req_form;
160 open(my $in, '<', $path) || die "$path: $!";
164 $self->{RECORD} = $marc;
168 if ( $offset == $hits ) {
180 my $z = new Net::Z3950::SimpleServer(
181 INIT => \&InitHandle,
182 SEARCH => \&SearchHandle,
183 FETCH => \&FetchHandle,
184 CLOSE => \&CloseHandle
186 $z->launch_server( $0, @ARGV );
188 package Net::Z3950::RPN::And;
191 my ($self,$usemap) = @_;
192 return $self->[0]->render($usemap) . ' AND ' . $self->[1]->render($usemap);
195 package Net::Z3950::RPN::Or;
198 my ($self,$usemap) = @_;
199 return $self->[0]->render($usemap) . ' OR ' . $self->[1]->render($usemap);
202 package Net::Z3950::RPN::AndNot;
205 my ($self,$usemap) = @_;
206 return $self->[0]->render($usemap) . ' AND NOT ' . $self->[1]->render($usemap);
209 package Net::Z3950::RPN::Term;
211 use Data::Dump qw(dump);
215 my ($self,$usemap) = @_;
217 die "no usemap" unless $usemap;
219 warn "# render ", dump($self);
220 warn "# usemap ", dump($usemap);
224 foreach my $attr ( @{ $self->{attributes} } ) {
225 my $type = $attr->{attributeType};
226 my $value = $attr->{attributeValue};
227 $attributes->{$type} = $value;
229 if ( defined( my $use = $attributes->{1} ) ) {
230 if ( defined( my $field = $usemap->{$use} ) ) {
234 warn "FIXME add $use in usemap ",dump( $usemap );
235 die { errcode => 114, errstr => $use }; ## Unsupported use attribute
238 if ( defined( my $rel = $attributes->{2} ) )
239 { ## No relation attributes supported
241 die { errcode => 117, errstr => $rel };
244 if ( defined( my $pos = $attributes->{3} ) )
245 { ## No position attributes either
247 die { errcode => 119, errstr => $pos };
250 if ( defined( my $struc = $attributes->{4} ) ) { ## No structure
251 if ( ( $struc != 1 ) && ( $struc != 2 ) ) {
252 die { errcode => 118, errstr => $struc };
255 if ( defined( $attributes->{5} ) ) { ## No truncation
256 die { errcode => 113, errstr => 5 };
258 my $comp = $attributes->{6};
260 if ( defined($comp) && ( $comp >= 2 ) ) {
261 $prefix = "all$prefix= ";
264 $prefix = "$prefix=";
268 my $q = $prefix . $self->{term} . '*';