projects
/
Biblio-Z3950.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
Merge branch 'master' of github.com:dpavlin/Biblio-Z3950
[Biblio-Z3950.git]
/
server.pl
diff --git
a/server.pl
b/server.pl
index
974edad
..
5823549
100755
(executable)
--- a/
server.pl
+++ b/
server.pl
@@
-6,17
+6,26
@@
use strict;
use Net::Z3950::SimpleServer;
use Net::Z3950::OID;
use Data::Dumper;
use Net::Z3950::SimpleServer;
use Net::Z3950::OID;
use Data::Dumper;
-use COBISS;
+
#
use COBISS;
use Aleph;
use Aleph;
+use GoogleBooks;
+use vuFind;
+use DPLA;
+use Encode;
+
+# databases names (left) must be in uppercase!
my $databases = {
my $databases = {
-
'COBISS' => 'COBISS',
+
#
'COBISS' => 'COBISS',
'NSK01' => 'Aleph',
'NSK10' => 'Aleph',
'ZAG01' => 'Aleph',
'NSK01' => 'Aleph',
'NSK10' => 'Aleph',
'ZAG01' => 'Aleph',
+ 'GOOGLEBOOKS' => 'GoogleBooks',
+ 'HATHITRUST' => 'vuFind',
+ 'DPLA' => 'DPLA',
};
};
-my $max_records =
3
; # XXX configure this
+my $max_records =
10
; # XXX configure this
my $max_result_sets = 10;
sub diag {
my $max_result_sets = 10;
sub diag {
@@
-24,29
+33,29
@@
sub diag {
}
sub InitHandle {
}
sub InitHandle {
- my $
this
= shift;
+ my $
self
= shift;
my $session = {};
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 {
$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 $query;
- my $database = uc $
this
->{DATABASES}->[0];
+ my $database = uc $
self
->{DATABASES}->[0];
my $module = $databases->{$database};
if ( ! defined $module ) {
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;
}
return;
}
@@
-57,20
+66,22
@@
diag "using $module for $database ", Dumper( $from );
eval { $query = $rpn->{query}->render( $from->usemap ); };
warn "ERROR: $@" if $@;
if ( $@ && ref($@) ) { ## Did someone/something report any errors?
eval { $query = $rpn->{query}->render( $from->usemap ); };
warn "ERROR: $@" 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;
}
return;
}
+ $query = decode('utf-8', $query); # FIXME Zoom encoding
+
diag "search for $query";
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 ) ) {
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";
return;
}
diag "got $hits hits";
@@
-85,60
+96,62
@@
diag "got $hits hits";
my $sets = $session->{SETS};
if ( defined( $sets->{$setname} ) && !$repl_set ) {
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 ) {
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;
return;
}
$sets->{$setname} = $rs;
- $
this
->{HITS} = $session->{HITS} = $hits;
+ $
self
->{HITS} = $session->{HITS} = $hits;
$session->{QUERY} = $query;
}
sub FetchHandle {
$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} ) ) {
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 ) {
return;
}
if ( $offset > $hits ) {
- $
this
->{ERR_CODE} = 13;
+ $
self
->{ERR_CODE} = 13;
return;
}
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
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";
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;
}
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 ) {
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";
}
warn "# rs result ", $#{ $rs->{results} },"\n";
}
@@
-148,8
+161,8
@@
sub FetchHandle {
if ( ! -e $path ) {
warn "ERROR: $path not found";
## Unsupported record format
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;
}
return;
}
@@
-158,20
+171,20
@@
sub FetchHandle {
local $/ = undef;
my $marc = <$in>;
close($in);
local $/ = undef;
my $marc = <$in>;
close($in);
- $
this
->{RECORD} = $marc;
+ $
self
->{RECORD} = $marc;
}
if ( $offset == $hits ) {
}
if ( $offset == $hits ) {
- $
this
->{LAST} = 1;
+ $
self
->{LAST} = 1;
}
else {
}
else {
- $
this
->{LAST} = 0;
+ $
self
->{LAST} = 0;
}
}
sub CloseHandle {
}
}
sub CloseHandle {
- my $
this
= shift;
+ my $
self
= shift;
}
my $z = new Net::Z3950::SimpleServer(
}
my $z = new Net::Z3950::SimpleServer(
@@
-185,41
+198,45
@@
$z->launch_server( $0, @ARGV );
package Net::Z3950::RPN::And;
sub render {
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 {
}
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 {
}
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);
}
package Net::Z3950::RPN::Term;
use Data::Dump qw(dump);
-use COBISS;
sub render {
sub render {
- my ($
this
,$usemap) = @_;
+ my ($
self
,$usemap) = @_;
die "no usemap" unless $usemap;
die "no usemap" unless $usemap;
-warn "# render ", dump($
this
);
+warn "# render ", dump($
self
);
warn "# usemap ", dump($usemap);
my $attributes = {};
my $prefix = "";
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;
my $type = $attr->{attributeType};
my $value = $attr->{attributeValue};
$attributes->{$type} = $value;
@@
-256,14
+273,18
@@
warn "# usemap ", dump($usemap);
my $comp = $attributes->{6};
if ($prefix) {
if ( defined($comp) && ( $comp >= 2 ) ) {
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;
}
print "# q: $q\n";
return $q;
}