X-Git-Url: http://git.rot13.org/?a=blobdiff_plain;f=server.pl;h=7b02608146806bcdba29ec85a47bdb48871328a3;hb=a0d3a60cd95afff5241f8e2d3a2955ecdffd1395;hp=974edadcb0f6f2b73a8645edfb955dfcf80f037b;hpb=da85de22e8f99851cf75b758c90d10cc2f2312b7;p=Biblio-Z3950.git diff --git a/server.pl b/server.pl index 974edad..7b02608 100755 --- a/server.pl +++ b/server.pl @@ -6,17 +6,34 @@ use strict; use Net::Z3950::SimpleServer; use Net::Z3950::OID; use Data::Dumper; -use COBISS; +#use COBISS; use Aleph; +use GoogleBooks; +use vuFind; +use DPLA; +use AlephTR; +use CROSBI; +use Encode; + +# databases names (left) must be in uppercase! my $databases = { - 'COBISS' => 'COBISS', +# 'COBISS' => 'COBISS', 'NSK01' => 'Aleph', 'NSK10' => 'Aleph', 'ZAG01' => 'Aleph', + 'GOOGLEBOOKS' => 'GoogleBooks', + 'HATHITRUST' => 'vuFind', + 'DPLA' => 'DPLA', + 'MKUTUP' => 'AlephTR', + 'CROSBI' => 'CROSBI', + 'CROSBI-CASOPIS' => 'CROSBI', + 'CROSBI-PREPRINT' => 'CROSBI', + 'CROSBI-RKNJIGA' => 'CROSBI', + 'CROSBI-ZBORNIK' => 'CROSBI', }; -my $max_records = 3; # XXX configure this +my $max_records = 10; # XXX configure this my $max_result_sets = 10; sub diag { @@ -24,29 +41,29 @@ sub diag { } sub InitHandle { - my $this = shift; + my $self = shift; my $session = {}; - $this->{HANDLE} = $session; - $this->{IMP_NAME} = "Biblio Z39.50"; - $this->{IMP_VER} = "0.2"; + $self->{HANDLE} = $session; + $self->{IMP_NAME} = "Biblio Z39.50"; + $self->{IMP_VER} = "0.2"; $session->{SETS} = {}; } sub SearchHandle { - my $this = shift; + my $self = shift; -diag "SearchHandle ",Dumper($this); +diag "SearchHandle ",Dumper($self); - my $session = $this->{HANDLE}; - my $rpn = $this->{RPN}; + my $session = $self->{HANDLE}; + my $rpn = $self->{RPN}; my $query; - my $database = uc $this->{DATABASES}->[0]; + my $database = uc $self->{DATABASES}->[0]; my $module = $databases->{$database}; if ( ! defined $module ) { - $this->{ERR_CODE} = 108; - warn $this->{ERR_STR} = "$database NOT FOUND in available databases: " . join(" ", keys %$databases); + $self->{ERR_CODE} = 108; + warn $self->{ERR_STR} = "$database NOT FOUND in available databases: " . join(" ", keys %$databases); return; } @@ -55,22 +72,24 @@ diag "SearchHandle ",Dumper($this); diag "using $module for $database ", Dumper( $from ); eval { $query = $rpn->{query}->render( $from->usemap ); }; - warn "ERROR: $@" if $@; + warn "ERROR: ", Dumper($@) if $@; if ( $@ && ref($@) ) { ## Did someone/something report any errors? - $this->{ERR_CODE} = $@->{errcode}; - $this->{ERR_STR} = $@->{errstr}; + $self->{ERR_CODE} = $@->{errcode}; + $self->{ERR_STR} = $@->{errstr}; return; } + $query = decode('utf-8', $query); # FIXME Zoom encoding + diag "search for $query"; - my $setname = $this->{SETNAME}; - my $repl_set = $this->{REPL_SET}; + my $setname = $self->{SETNAME}; + my $repl_set = $self->{REPL_SET}; diag "SETNAME $setname REPL_SET $repl_set"; my $hits; unless ( $hits = $from->search( $query ) ) { - warn $this->{ERR_STR} = "no results for $query"; - $this->{ERR_CODE} = 108; + warn $self->{ERR_STR} = "no results for $query"; + $self->{ERR_CODE} = 108; return; } diag "got $hits hits"; @@ -85,60 +104,62 @@ diag "got $hits hits"; my $sets = $session->{SETS}; if ( defined( $sets->{$setname} ) && !$repl_set ) { - $this->{ERR_CODE} = 21; + $self->{ERR_CODE} = 21; return; } if ( scalar keys %$sets >= $max_result_sets ) { - $this->{ERR_CODE} = 112; - $this->{ERR_STR} = "Max number is $max_result_sets"; + $self->{ERR_CODE} = 112; + $self->{ERR_STR} = "Max number is $max_result_sets"; return; } $sets->{$setname} = $rs; - $this->{HITS} = $session->{HITS} = $hits; + $self->{HITS} = $session->{HITS} = $hits; $session->{QUERY} = $query; } sub FetchHandle { - my $this = shift; - my $session = $this->{HANDLE}; - my $setname = $this->{SETNAME}; - my $req_form = $this->{REQ_FORM}; - my $offset = $this->{OFFSET}; + my $self = shift; + my $session = $self->{HANDLE}; + my $setname = $self->{SETNAME}; + my $req_form = $self->{REQ_FORM}; + my $offset = $self->{OFFSET}; my $sets = $session->{SETS}; my $hits = $session->{HITS}; my $rs; my $record; if ( !defined( $rs = $sets->{$setname} ) ) { - $this->{ERR_CODE} = 30; + $self->{ERR_CODE} = 30; return; } if ( $offset > $hits ) { - $this->{ERR_CODE} = 13; + $self->{ERR_CODE} = 13; return; } - $this->{BASENAME} = "HtmlZ3950"; + $self->{BASENAME} = $rs->{database}; my $format = $req_form eq Net::Z3950::OID::xml() ? 'xml' : $req_form eq Net::Z3950::OID::unimarc() ? 'unimarc' : $req_form eq Net::Z3950::OID::usmarc() ? 'marc' : # XXX usmarc -> marc - undef; + die "unknown format $req_form"; if ( ! $format ) { warn "ERROR: $req_form format not supported"; - $this->{ERR_CODE} = 239; ## Unsupported record format - $this->{ERR_STR} = $req_form; + $self->{ERR_CODE} = 239; ## Unsupported record format + $self->{ERR_STR} = $req_form; return; } - $this->{REP_FORM} = $req_form; + $self->{REP_FORM} = $req_form; my $from = $rs->{from} || die "no from?"; # fetch records up to offset while( $#{ $rs->{results} } < $offset ) { - push @{ $rs->{results} }, $from->next_marc; + my $marc = $from->next_marc; + last if ! $marc; # abort results + push @{ $rs->{results} }, $marc; warn "# rs result ", $#{ $rs->{results} },"\n"; } @@ -148,8 +169,8 @@ sub FetchHandle { if ( ! -e $path ) { warn "ERROR: $path not found"; ## Unsupported record format - $this->{ERR_CODE} = 239; - $this->{ERR_STR} = $req_form; + $self->{ERR_CODE} = 239; + $self->{ERR_STR} = $req_form; return; } @@ -158,20 +179,20 @@ sub FetchHandle { local $/ = undef; my $marc = <$in>; close($in); - $this->{RECORD} = $marc; + $self->{RECORD} = $marc; } if ( $offset == $hits ) { - $this->{LAST} = 1; + $self->{LAST} = 1; } else { - $this->{LAST} = 0; + $self->{LAST} = 0; } } sub CloseHandle { - my $this = shift; + my $self = shift; } my $z = new Net::Z3950::SimpleServer( @@ -185,41 +206,45 @@ $z->launch_server( $0, @ARGV ); package Net::Z3950::RPN::And; sub render { - my ($this,$usemap) = @_; - my $this = shift; - return $this->[0]->render() . ' AND ' . $this->[1]->render(); + my ($self,$usemap) = @_; + return $self->[0]->render($usemap) + . ( $usemap->{RPN}->{And} || ' AND ' ) + . $self->[1]->render($usemap); } package Net::Z3950::RPN::Or; sub render { - my $this = shift; - return $this->[0]->render() . ' OR ' . $this->[1]->render(); + my ($self,$usemap) = @_; + return $self->[0]->render($usemap) + . ( $usemap->{RPN}->{Or} || ' OR ' ) + . $self->[1]->render($usemap); } package Net::Z3950::RPN::AndNot; sub render { - my $this = shift; - return $this->[0]->render() . ' AND NOT ' . $this->[1]->render(); + my ($self,$usemap) = @_; + return $self->[0]->render($usemap) + . ( $usemap->{RPN}->{Or} || ' AND NOT ' ) + . $self->[1]->render($usemap); } package Net::Z3950::RPN::Term; use Data::Dump qw(dump); -use COBISS; sub render { - my ($this,$usemap) = @_; + my ($self,$usemap) = @_; die "no usemap" unless $usemap; -warn "# render ", dump($this); +warn "# render ", dump($self); warn "# usemap ", dump($usemap); my $attributes = {}; my $prefix = ""; - foreach my $attr ( @{ $this->{attributes} } ) { + foreach my $attr ( @{ $self->{attributes} } ) { my $type = $attr->{attributeType}; my $value = $attr->{attributeValue}; $attributes->{$type} = $value; @@ -251,19 +276,24 @@ warn "# usemap ", dump($usemap); } } if ( defined( $attributes->{5} ) ) { ## No truncation - die { errcode => 113, errstr => 5 }; +# die { errcode => 113, errstr => 5 }; + warn "# truncation is ignored"; } my $comp = $attributes->{6}; if ($prefix) { if ( defined($comp) && ( $comp >= 2 ) ) { - $prefix = "all$prefix= "; - } - else { - $prefix = "$prefix="; + $prefix = "all$prefix"; # FIXME? } } - my $q = $prefix . $this->{term}; + my $q; + + if ( $usemap->{prefix_term} ) { + warn "# using custom prefix_term query"; + $q = $usemap->{prefix_term}->( $prefix, $self->{term} ); + } else { + $q = $prefix . $self->{term} . '*'; + } print "# q: $q\n"; return $q; }