z3950/server/zed-koha-server.pl

   1 #!/usr/bin/perl -w
   2 #
   3 # Copyright 2000-2002 Katipo Communications
   4 #
   5 # This file is part of Koha.
   6 #
   7 # Koha is free software; you can redistribute it and/or modify it under the
   8 # terms of the GNU General Public License as published by the Free Software
   9 # Foundation; either version 2 of the License, or (at your option) any later
  10 # version.
  11 #
  12 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
  13 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
  14 # A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
  15 #
  16 # You should have received a copy of the GNU General Public License along with
  17 # Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
  18 # Suite 330, Boston, MA  02111-1307 USA
  19 #
  20 #-----------------------------------
  21 # Script Name: zed-koha-server.pl
  22 # Script Version: 1.4
  23 # Date:  2004/06/02
  24 # Author:  Joshua Ferraro [jmf at kados dot org]
  25 # Description: A very basic Z3950 Server
  26 # Usage: zed-koha-server.pl
  27 # Revision History:
  28 #    0.00  2003/08/14:  Original version; search works.
  29 #    0.01  2003/10/02:  First functional version; search and fetch working
  30 #                        records returned in USMARC (ISO2709) format,
  31 #                        Bath compliant to Level 1 in Functional Areas A, B.
  32 #    0.02  2004/04/14:  Cleaned up documentation, etc. No functional
  33 #                        changes.
  34 #    1.30  2004/04/22:  Changing version numbers to correspond with CVS;
  35 #                        Fixed the substitution bug (e.g., 4=100 before 4=1);
  36 #                        Added support for the truncation attribute (5=1 and
  37 #                        5=100; thanks to Tomasz M. Wolniewicz for pointing
  38 #                        out these improvements)
  39 #    1.4.0 2004/06/02:  Changed sql queries to account for the difference
  40 #                        between bibid and biblionumber.  Thanks again to
  41 #                        Tomasz M. Wolniewicz for suggesting a great solution
  42 #                        to this problem.
  43 #-----------------------------------
  44 # Note: After installing SimpleServer (indexdata.dk/simpleserver) and
  45 # changing the leader information in Koha's MARCgetbiblio subroutine in
  46 # Biblio.pm you can run this script as root:
  47 #
  48 # ./zed-koha-server.pl
  49 #
  50 # and the server will start running on port 9999 and will allow searching
  51 # and retrieval of records in MARC21 (USMARC; ISO2709) bibliographic format.
  52 # ----------------------------------
  53 use DBI;
  54 use Net::Z3950::OID;
  55 use Net::Z3950::SimpleServer;
  56 use MARC::Record;
  57 use C4::Context;
  58 use C4::Biblio;
  59 use strict;
  60 # my $dbh = C4::Context->dbh;
  61 my @bib_list;           ## Stores the list of biblionumbers in a query
  62                         ## I should eventually move this to different scope
  63
  64 my $handler = Net::Z3950::SimpleServer->new(INIT => \&init_handler,
  65                                             SEARCH => \&search_handler,
  66                                             FETCH => \&fetch_handler);
  67
  68 $handler->launch_server("zed-koha-server.pl", @ARGV);
  69
  70 sub init_handler {
  71         my $args = shift;
  72         my $session = {};
  73
  74         # FIXME: I should force use of my database name
  75         $args->{IMP_NAME} = "Zed-Koha";
  76         $args->{IMP_VER} = "1.40";
  77         $args->{ERR_CODE} = 0;
  78         $args->{HANDLE} = $session;
  79         if (defined($args->{PASS}) && defined($args->{USER})) {
  80             printf("Received USER/PASS=%s/%s\n", $args->{USER},$args->{PASS});
  81         }
  82
  83 }
  84
  85
  86 sub run_query {         ## Run the query and store the biblionumbers:
  87         my ($sql_query, $query, $args) = @_;
  88                 my $dbh = C4::Context->dbh;
  89         my $sth_get = $dbh->prepare("$sql_query");
  90
  91         ## Send the query to the database:
  92         $sth_get->execute($query);
  93         my $count = 0;
  94         while(my ($data)=$sth_get->fetchrow_array) {
  95
  96                 ## Store Biblioitem info for later
  97                 $bib_list[$count] = "$data";
  98
  99                 ## Implement count:
 100                 $count ++;
 101         }
 102         $args->{HITS} = $count;
 103         print "got search: ", $args->{RPN}->{query}->render(), "\n";
 104 }
 105
 106 sub search_handler {
 107         my($args) = @_;
 108         ## Place the user's query into a variable
 109         my $query = $args->{QUERY};
 110
 111         ## The actual Term
 112         my $term = $args->{term};
 113         $term =~ s| |\%|g;
 114         $term .= "\%";         ## Add the wildcard to search term
 115
 116         $_ = "$query";
 117
 118                 ## Strip out the junk and call the mysql query subroutine:
 119         if (/1=7/) {            ## isbn
 120                 $query =~ s|\@attrset 1.2.840.10003.3.1 \@attr 1=7 ||g;
 121                 $query  =~ s|"||g;
 122                 $query =~ s| |%|g;
 123
 124                 ## Bib-1 Structure Attributes:
 125                 $query =~ s|\@attr||g;
 126
 127                 $query =~ s|4=100||g;   ## date (un-normalized)
 128                 $query =~ s|4=101||g;   ## name (normalized)
 129                 $query =~ s|4=102||g;   ## sme (un-normalized)
 130                 $query =~ s|4=1||g;     ## Phrase
 131                 $query =~ s|4=2||g;     ## Keyword
 132                 $query =~ s|4=3||g;     ## Key
 133                 $query =~ s|4=4||g;     ## year
 134                 $query =~ s|4=5||g;     ## Date (normalized)
 135                 $query =~ s|4=6||g;     ## word list
 136                 $query =~ s|5=100||g;   ## truncation
 137                 $query =~ s|5=1||g;     ## truncation
 138                 $query =~ s|\@and ||g;
 139                 $query =~ s|2=3||g;
 140
 141                 $query =~ s|,|%|g;      ## replace commas with wildcard
 142                 $query .= "\%";         ## Add the wildcard to search term
 143                 $query .= "\%";         ## Add the wildcard to search term
 144                 print "The term was:\n";
 145                 print "$term\n";
 146                 print "The query was:\n";
 147                 print "$query\n";
 148                 my $sql_query = "SELECT marc_biblio.bibid FROM marc_biblio RIGHT JOIN biblioitems ON marc_biblio.biblionumber = biblioitems.biblionumber WHERE biblioitems.isbn LIKE ?";
 149                 &run_query($sql_query, $query, $args);
 150
 151         }
 152         elsif (/1=1003/) {      ## author
 153                 $query =~ s|\@attrset||g;
 154                 $query =~ s|1.2.840.10003.3.1||g;
 155                 $query =~ s|1=1003||g;
 156
 157                ## Bib-1 Structure Attributes:
 158                 $query =~ s|\@attr ||g;
 159
 160                 $query =~ s|4=100||g;  ## date (un-normalized)
 161                 $query =~ s|4=101||g;  ## name (normalized)
 162                 $query =~ s|4=102||g;  ## sme (un-normalized)
 163                 $query =~ s|4=1||g;    ## Phrase
 164                 $query =~ s|4=2||g;    ## Keyword
 165                 $query =~ s|4=3||g;    ## Key
 166                 $query =~ s|4=4||g;    ## year
 167                 $query =~ s|4=5||g;    ## Date (normalized)
 168                 $query =~ s|4=6||g;    ## word list
 169                 $query =~ s|5=100||g;   ## truncation
 170                 $query =~ s|5=1||g;     ## truncation
 171
 172                 $query =~ s|2=3||g;
 173                 $query =~ s|"||g;
 174                 $query =~ s| |%|g;
 175                 $query .= "\%";         ## Add the wildcard to search term
 176                 print "$query\n";
 177                 my $sql_query = "SELECT marc_biblio.bibid FROM marc_biblio RIGHT JOIN biblio ON marc_biblio.biblionumber = biblio.biblionumber WHERE biblio.author LIKE ?";
 178                 &run_query($sql_query, $query, $args);
 179 ## used for debugging--works!
 180 ##              print "@bib_list\n";
 181         }
 182         elsif (/1=4/) {         ## title
 183                 $query =~ s|\@attrset||g;
 184                 $query =~ s|1.2.840.10003.3.1||g;
 185                 $query =~ s|1=4||g;
 186                 $query  =~ s|"||g;
 187                 $query  =~ s| |%|g;
 188
 189                 ## Bib-1 Structure Attributes:
 190                 $query =~ s|\@attr||g;
 191
 192                 $query =~ s|4=100||g;  ## date (un-normalized)
 193                 $query =~ s|4=101||g;  ## name (normalized)
 194                 $query =~ s|4=102||g;  ## sme (un-normalized)
 195                 $query =~ s|4=1||g;    ## Phrase
 196                 $query =~ s|4=2||g;    ## Keyword
 197                 $query =~ s|4=3||g;    ## Key
 198                 $query =~ s|4=4||g;    ## year
 199                 $query =~ s|4=5||g;    ## Date (normalized)
 200                 $query =~ s|4=6||g;    ## word list
 201                 $query =~ s|5=100||g;   ## truncation
 202                 $query =~ s|5=1||g;     ## truncation
 203
 204                 $query =~ s|2=3||g;
 205                 #$query =~ s|\@and||g;
 206                 $query .= "\%";         ## Add the wildcard to search term
 207                 print "The term was:\n";
 208                 print "$term\n";
 209                 print "The query was:\n";
 210                 print "$query\n";
 211                 my $sql_query = "SELECT marc_biblio.bibid FROM marc_biblio RIGHT JOIN biblio ON marc_biblio.biblionumber = biblio.biblionumber WHERE biblio.title LIKE ?";
 212                 &run_query($sql_query, $query, $args);
 213         }
 214         elsif (/1=21/) {         ## subject
 215                 $query =~ s|\@attrset 1.2.840.10003.3.1 \@attr 1=21 ||g;
 216                 $query  =~ s|"||g;
 217                 $query  =~ s| |%|g;
 218
 219                 ## Bib-1 Structure Attributes:
 220                 $query =~ s|\@attr ||g;
 221                 $query =~ s|4=100||g;  ## date (un-normalized)
 222                 $query =~ s|4=101||g;  ## name (normalized)
 223                 $query =~ s|4=102||g;  ## sme (un-normalized)
 224
 225                 $query =~ s|4=1||g;    ## Phrase
 226                 $query =~ s|4=2||g;    ## Keyword
 227                 $query =~ s|4=3||g;    ## Key
 228                 $query =~ s|4=4||g;    ## year
 229                 $query =~ s|4=5||g;    ## Date (normalized)
 230                 $query =~ s|4=6||g;    ## word list
 231                 $query =~ s|5=100||g;   ## truncation
 232                 $query =~ s|5=1||g;     ## truncation
 233
 234                 $query .= "\%";         ## Add the wildcard to search term
 235                 print "$query\n";
 236                 my $sql_query = "SELECT marc_biblio.bibid FROM marc_biblio RIGHT JOIN biblio ON marc_biblio.biblionumber = biblio.biblionumber WHERE biblio.subject LIKE ?";
 237                 &run_query($sql_query, $query, $args);
 238         }
 239         elsif (/1=1016/) {       ## any
 240                 $query =~ s|\@attrset 1.2.840.10003.3.1 \@attr 1=1016 ||g;
 241                 $query  =~ s|"||g;
 242                 $query  =~ s| |%|g;
 243
 244                 ## Bib-1 Structure Attributes:
 245                 $query =~ s|\@attr||g;
 246
 247                 $query =~ s|4=100||g;  ## date (un-normalized)
 248                 $query =~ s|4=101||g;  ## name (normalized)
 249                 $query =~ s|4=102||g;  ## sme (un-normalized)
 250
 251                 $query =~ s|4=1||g;    ## Phrase
 252                 $query =~ s|4=2||g;    ## Keyword
 253                 $query =~ s|4=3||g;    ## Key
 254                 $query =~ s|4=4||g;    ## year
 255                 $query =~ s|4=5||g;    ## Date (normalized)
 256                 $query =~ s|4=6||g;    ## word list
 257                 $query =~ s|5=100||g;   ## truncation
 258                 $query =~ s|5=1||g;     ## truncation
 259
 260                 $query .= "\%";         ## Add the wildcard to search term
 261                 print "$query\n";
 262                 my $sql_query = "SELECT bibid FROM marc_word WHERE word LIKE?";
 263                 &run_query($sql_query, $query, $args);
 264         }
 265 }
 266 sub fetch_handler {
 267         my ($args) = @_;
 268         # warn "in fetch_handler";      ## troubleshooting
 269         my $offset = $args->{OFFSET};
 270         $offset -= 1;                   ## because $args->{OFFSET} 1 = record #1
 271         chomp (my $bibid = $bib_list[$offset]); ## Not sure about this
 272                                 ## print "the bibid is:$bibid\n";
 273                                 my $dbh = C4::Context->dbh;
 274                                 my $MARCRecord = &MARCgetbiblio($dbh,$bibid);
 275                                 $MARCRecord->leader('     nac  22     1u 4500');
 276                 ## Set the REP_FORM
 277                 $args->{REP_FORM} = &Net::Z3950::OID::unimarc;
 278
 279                 ## Return the record string to the client
 280                         $args->{RECORD} = $MARCRecord->as_usmarc();
 281 #               $args->{RECORD} = $recordstringdone;
 282
 283 }
 284
 285
 286 ## This stuff doesn't work yet...I should include boolean searching someday
 287 ## though
 288 package Net::Z3950::RPN::Term;
 289 sub render {
 290     my $self = shift;
 291     return '"' . $self->{term} . '"';
 292 }
 293
 294 package Net::Z3950::RPN::And;
 295 sub render {
 296     my $self = shift;
 297     return '(' . $self->[0]->render() . ' AND ' .
 298                  $self->[1]->render() . ')';
 299 }
 300
 301 package Net::Z3950::RPN::Or;
 302 sub render {
 303     my $self = shift;
 304     return '(' . $self->[0]->render() . ' OR ' .
 305                  $self->[1]->render() . ')';
 306 }
 307
 308 package Net::Z3950::RPN::AndNot;
 309 sub render {
 310     my $self = shift;
 311     return '(' . $self->[0]->render() . ' ANDNOT ' .
 312                  $self->[1]->render() . ')';
 313 }