6 use Net::Z3950::SimpleServer;
19 my $max_records = 3; # XXX configure this
20 my $max_result_sets = 10;
30 $this->{HANDLE} = $session;
31 $this->{IMP_NAME} = "Biblio Z39.50";
32 $this->{IMP_VER} = "0.2";
33 $session->{SETS} = {};
39 diag "SearchHandle ",Dumper($this);
41 my $session = $this->{HANDLE};
42 my $rpn = $this->{RPN};
45 my $database = uc $this->{DATABASES}->[0];
46 my $module = $databases->{$database};
47 if ( ! defined $module ) {
48 $this->{ERR_CODE} = 108;
49 warn $this->{ERR_STR} = "$database NOT FOUND in available databases: " . join(" ", keys %$databases);
53 my $from = $module->new( $database );
55 diag "using $module for $database ", Dumper( $from );
57 eval { $query = $rpn->{query}->render( $from->usemap ); };
58 warn "ERROR: $@" if $@;
59 if ( $@ && ref($@) ) { ## Did someone/something report any errors?
60 $this->{ERR_CODE} = $@->{errcode};
61 $this->{ERR_STR} = $@->{errstr};
65 diag "search for $query";
67 my $setname = $this->{SETNAME};
68 my $repl_set = $this->{REPL_SET};
69 diag "SETNAME $setname REPL_SET $repl_set";
71 unless ( $hits = $from->search( $query ) ) {
72 $this->{ERR_CODE} = 108;
75 diag "got $hits hits";
78 upper => $hits < $max_records ? $max_records : $hits,
81 results => [ undef ], # we don't use 0 element
83 my $sets = $session->{SETS};
85 if ( defined( $sets->{$setname} ) && !$repl_set ) {
86 $this->{ERR_CODE} = 21;
89 if ( scalar keys %$sets >= $max_result_sets ) {
90 $this->{ERR_CODE} = 112;
91 $this->{ERR_STR} = "Max number is $max_result_sets";
94 $sets->{$setname} = $rs;
95 $this->{HITS} = $session->{HITS} = $hits;
96 $session->{QUERY} = $query;
101 my $session = $this->{HANDLE};
102 my $setname = $this->{SETNAME};
103 my $req_form = $this->{REQ_FORM};
104 my $offset = $this->{OFFSET};
105 my $sets = $session->{SETS};
106 my $hits = $session->{HITS};
110 if ( !defined( $rs = $sets->{$setname} ) ) {
111 $this->{ERR_CODE} = 30;
114 if ( $offset > $hits ) {
115 $this->{ERR_CODE} = 13;
119 $this->{BASENAME} = "HtmlZ3950";
121 my $format = 'usmarc';
123 # if ( !defined($req_form) || ( $req_form eq &Net::Z3950::OID::xml ) )
126 $this->{REP_FORM} = &Net::Z3950::OID::xml;
127 $this->{RECORD} = '<xml>FIXME: not implementd</xml>';
129 elsif ( $req_form eq &Net::Z3950::OID::unimarc ) { # FIXME convert to usmarc
130 $this->{REP_FORM} = &Net::Z3950::OID::unimarc;
133 elsif ( $req_form eq &Net::Z3950::OID::usmarc ) { # FIXME convert to usmarc
134 $this->{REP_FORM} = &Net::Z3950::OID::usmarc;
137 else { ## Unsupported record format
138 $this->{ERR_CODE} = 239;
139 $this->{ERR_STR} = $req_form;
144 my $from = $rs->{from} || die "no from?";
145 # fetch records up to offset
146 while( $#{ $rs->{results} } < $offset ) {
147 push @{ $rs->{results} }, $from->next_marc;
148 warn "# rs result ", $#{ $rs->{results} }, " $format\n";
151 my $id = $rs->{results}->[$offset] || die "no id for record $offset in ",Dumper( $rs->{results} );
153 my $path = "marc/$id.$format";
155 ## Unsupported record format
156 $this->{ERR_CODE} = 239;
157 $this->{ERR_STR} = $req_form;
162 open(my $in, '<', $path) || die "$path: $!";
166 $this->{RECORD} = $in;
170 if ( $offset == $hits ) {
182 my $z = new Net::Z3950::SimpleServer(
183 INIT => \&InitHandle,
184 SEARCH => \&SearchHandle,
185 FETCH => \&FetchHandle,
186 CLOSE => \&CloseHandle
188 $z->launch_server( $0, @ARGV );
190 package Net::Z3950::RPN::And;
194 return $this->[0]->render() . ' AND ' . $this->[1]->render();
197 package Net::Z3950::RPN::Or;
201 return $this->[0]->render() . ' OR ' . $this->[1]->render();
204 package Net::Z3950::RPN::AndNot;
208 return $this->[0]->render() . ' AND NOT ' . $this->[1]->render();
211 package Net::Z3950::RPN::Term;
213 use Data::Dump qw(dump);
217 my ($this,$usemap) = @_;
219 warn "# render ", dump($this);
220 warn "# usemap ", dump($usemap);
224 foreach my $attr ( @{ $this->{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 die { errcode => 114, errstr => $use }; ## Unsupported use attribute
237 if ( defined( my $rel = $attributes->{2} ) )
238 { ## No relation attributes supported
240 die { errcode => 117, errstr => $rel };
243 if ( defined( my $pos = $attributes->{3} ) )
244 { ## No position attributes either
246 die { errcode => 119, errstr => $pos };
249 if ( defined( my $struc = $attributes->{4} ) ) { ## No structure
250 if ( ( $struc != 1 ) && ( $struc != 2 ) ) {
251 die { errcode => 118, errstr => $struc };
254 if ( defined( $attributes->{5} ) ) { ## No truncation
255 die { errcode => 113, errstr => 5 };
257 my $comp = $attributes->{6};
259 if ( defined($comp) && ( $comp >= 2 ) ) {
260 $prefix = "all$prefix= ";
263 $prefix = "$prefix=";
267 my $q = $prefix . $this->{term};