ignore ssl certificate errors

[Biblio-Z3950.git] / server.pl

diff --git a/server.pl b/server.pl
index 3fc2ee0..8ec3a61 100755 (executable)
--- a/server.pl
+++ b/server.pl
@@ -6,17 +6,35 @@ 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',
+       'CROSBI-OSTALO' => 'CROSBI',
 };
 
-my $max_records = 3; # XXX configure this
+my $max_records = 10; # XXX configure this
 my $max_result_sets = 10;
 
 sub diag {
@@ -55,13 +73,15 @@ diag "SearchHandle ",Dumper($self);
 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?
         $self->{ERR_CODE} = $@->{errcode};
         $self->{ERR_STR}  = $@->{errstr};
         return;
     }
 
+       $query = decode('utf-8', $query); # FIXME Zoom encoding
+
 diag "search for $query";
 
     my $setname  = $self->{SETNAME};
@@ -118,13 +138,13 @@ sub FetchHandle {
         return;
     }
 
-    $self->{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";
@@ -138,7 +158,9 @@ sub FetchHandle {
        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";
        }
 
@@ -186,28 +208,32 @@ package Net::Z3950::RPN::And;
 
 sub render {
        my ($self,$usemap) = @_;
-    my $self = shift;
-    return $self->[0]->render() . ' AND ' . $self->[1]->render();
+    return $self->[0]->render($usemap)
+               . ( $usemap->{RPN}->{And} || ' AND ' )
+               . $self->[1]->render($usemap);
 }
 
 package Net::Z3950::RPN::Or;
 
 sub render {
-    my $self = shift;
-    return $self->[0]->render() . ' OR ' . $self->[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 $self = shift;
-    return $self->[0]->render() . ' AND NOT ' . $self->[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 ($self,$usemap) = @_;
@@ -251,19 +277,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 . $self->{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;
 }