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 $sth_get = $dbh->prepare("$sql_query");
  89
  90         ## Send the query to the database:
  91         $sth_get->execute($query);
  92         my $count = 0;
  93         while(my ($data)=$sth_get->fetchrow_array) {
  94
  95                 ## Store Biblioitem info for later
  96                 $bib_list[$count] = "$data";
  97
  98                 ## Implement count:
  99                 $count ++;
 100         }
 101         $args->{HITS} = $count;
 102         print "got search: ", $args->{RPN}->{query}->render(), "\n";
 103 }
 104
 105 sub search_handler {
 106         my($args) = @_;
 107         ## Place the user's query into a variable
 108         my $query = $args->{QUERY};
 109
 110         ## The actual Term
 111         my $term = $args->{term};
 112         $term =~ s| |\%|g;
 113         $term .= "\%";         ## Add the wildcard to search term
 114
 115         $_ = "$query";
 116
 117                 ## Strip out the junk and call the mysql query subroutine:
 118         if (/1=7/) {            ## isbn
 119                 $query =~ s|\@attrset 1.2.840.10003.3.1 \@attr 1=7 ||g;
 120                 $query  =~ s|"||g;
 121                 $query =~ s| |%|g;
 122
 123                 ## Bib-1 Structure Attributes:
 124                 $query =~ s|\@attr||g;
 125
 126                 $query =~ s|4=100||g;   ## date (un-normalized)
 127                 $query =~ s|4=101||g;   ## name (normalized)
 128                 $query =~ s|4=102||g;   ## sme (un-normalized)
 129                 $query =~ s|4=1||g;     ## Phrase
 130                 $query =~ s|4=2||g;     ## Keyword
 131                 $query =~ s|4=3||g;     ## Key
 132                 $query =~ s|4=4||g;     ## year
 133                 $query =~ s|4=5||g;     ## Date (normalized)
 134                 $query =~ s|4=6||g;     ## word list
 135                 $query =~ s|5=100||g;   ## truncation
 136                 $query =~ s|5=1||g;     ## truncation
 137                 $query =~ s|\@and ||g;
 138                 $query =~ s|2=3||g;
 139
 140                 $query =~ s|,|%|g;      ## replace commas with wildcard
 141                 $query .= "\%";         ## Add the wildcard to search term
 142                 $query .= "\%";         ## Add the wildcard to search term
 143                 print "The term was:\n";
 144                 print "$term\n";
 145                 print "The query was:\n";
 146                 print "$query\n";
 147                 my $sql_query = "SELECT marc_biblio.bibid FROM marc_biblio RIGHT JOIN biblio ON marc_biblio.biblionumber = biblio.biblionumber WHERE biblio.isbn LIKE ?";
 148                 &run_query($sql_query, $query, $args);
 149
 150         }
 151         elsif (/1=1003/) {      ## author
 152                 $query =~ s|\@attrset||g;
 153                 $query =~ s|1.2.840.10003.3.1||g;
 154                 $query =~ s|1=1003||g;
 155
 156                ## Bib-1 Structure Attributes:
 157                 $query =~ s|\@attr ||g;
 158
 159                 $query =~ s|4=100||g;  ## date (un-normalized)
 160                 $query =~ s|4=101||g;  ## name (normalized)
 161                 $query =~ s|4=102||g;  ## sme (un-normalized)
 162                 $query =~ s|4=1||g;    ## Phrase
 163                 $query =~ s|4=2||g;    ## Keyword
 164                 $query =~ s|4=3||g;    ## Key
 165                 $query =~ s|4=4||g;    ## year
 166                 $query =~ s|4=5||g;    ## Date (normalized)
 167                 $query =~ s|4=6||g;    ## word list
 168                 $query =~ s|5=100||g;   ## truncation
 169                 $query =~ s|5=1||g;     ## truncation
 170
 171                 $query =~ s|2=3||g;
 172                 $query =~ s|"||g;
 173                 $query =~ s| |%|g;
 174                 $query .= "\%";         ## Add the wildcard to search term
 175                 print "$query\n";
 176                 my $sql_query = "SELECT marc_biblio.bibid FROM marc_biblio RIGHT JOIN biblio ON marc_biblio.biblionumber = biblio.biblionumber WHERE biblio.author LIKE ?";
 177                 &run_query($sql_query, $query, $args);
 178 ## used for debugging--works!
 179 ##              print "@bib_list\n";
 180         }
 181         elsif (/1=4/) {         ## title
 182                 $query =~ s|\@attrset||g;
 183                 $query =~ s|1.2.840.10003.3.1||g;
 184                 $query =~ s|1=4||g;
 185                 $query  =~ s|"||g;
 186                 $query  =~ s| |%|g;
 187
 188                 ## Bib-1 Structure Attributes:
 189                 $query =~ s|\@attr||g;
 190
 191                 $query =~ s|4=100||g;  ## date (un-normalized)
 192                 $query =~ s|4=101||g;  ## name (normalized)
 193                 $query =~ s|4=102||g;  ## sme (un-normalized)
 194                 $query =~ s|4=1||g;    ## Phrase
 195                 $query =~ s|4=2||g;    ## Keyword
 196                 $query =~ s|4=3||g;    ## Key
 197                 $query =~ s|4=4||g;    ## year
 198                 $query =~ s|4=5||g;    ## Date (normalized)
 199                 $query =~ s|4=6||g;    ## word list
 200                 $query =~ s|5=100||g;   ## truncation
 201                 $query =~ s|5=1||g;     ## truncation
 202
 203                 $query =~ s|2=3||g;
 204                 #$query =~ s|\@and||g;
 205                 $query .= "\%";         ## Add the wildcard to search term
 206                 print "The term was:\n";
 207                 print "$term\n";
 208                 print "The query was:\n";
 209                 print "$query\n";
 210                 my $sql_query = "SELECT marc_biblio.bibid FROM marc_biblio RIGHT JOIN biblio ON marc_biblio.biblionumber = biblio.biblionumber WHERE biblio.title LIKE ?";
 211                 &run_query($sql_query, $query, $args);
 212         }
 213         elsif (/1=21/) {         ## subject
 214                 $query =~ s|\@attrset 1.2.840.10003.3.1 \@attr 1=21 ||g;
 215                 $query  =~ s|"||g;
 216                 $query  =~ s| |%|g;
 217
 218                 ## Bib-1 Structure Attributes:
 219                 $query =~ s|\@attr ||g;
 220                 $query =~ s|4=100||g;  ## date (un-normalized)
 221                 $query =~ s|4=101||g;  ## name (normalized)
 222                 $query =~ s|4=102||g;  ## sme (un-normalized)
 223
 224                 $query =~ s|4=1||g;    ## Phrase
 225                 $query =~ s|4=2||g;    ## Keyword
 226                 $query =~ s|4=3||g;    ## Key
 227                 $query =~ s|4=4||g;    ## year
 228                 $query =~ s|4=5||g;    ## Date (normalized)
 229                 $query =~ s|4=6||g;    ## word list
 230                 $query =~ s|5=100||g;   ## truncation
 231                 $query =~ s|5=1||g;     ## truncation
 232
 233                 $query .= "\%";         ## Add the wildcard to search term
 234                 print "$query\n";
 235                 my $sql_query = "SELECT marc_biblio.bibid FROM marc_biblio RIGHT JOIN biblio ON marc_biblio.biblionumber = biblio.biblionumber WHERE biblio.subject LIKE ?";
 236                 &run_query($sql_query, $query, $args);
 237         }
 238         elsif (/1=1016/) {       ## any
 239                 $query =~ s|\@attrset 1.2.840.10003.3.1 \@attr 1=1016 ||g;
 240                 $query  =~ s|"||g;
 241                 $query  =~ s| |%|g;
 242
 243                 ## Bib-1 Structure Attributes:
 244                 $query =~ s|\@attr||g;
 245
 246                 $query =~ s|4=100||g;  ## date (un-normalized)
 247                 $query =~ s|4=101||g;  ## name (normalized)
 248                 $query =~ s|4=102||g;  ## sme (un-normalized)
 249
 250                 $query =~ s|4=1||g;    ## Phrase
 251                 $query =~ s|4=2||g;    ## Keyword
 252                 $query =~ s|4=3||g;    ## Key
 253                 $query =~ s|4=4||g;    ## year
 254                 $query =~ s|4=5||g;    ## Date (normalized)
 255                 $query =~ s|4=6||g;    ## word list
 256                 $query =~ s|5=100||g;   ## truncation
 257                 $query =~ s|5=1||g;     ## truncation
 258
 259                 $query .= "\%";         ## Add the wildcard to search term
 260                 print "$query\n";
 261                 my $sql_query = "SELECT bibid FROM marc_word WHERE word LIKE?";
 262                 &run_query($sql_query, $query, $args);
 263         }
 264 }
 265 sub fetch_handler {
 266         my ($args) = @_;
 267         # warn "in fetch_handler";      ## troubleshooting
 268         my $offset = $args->{OFFSET};
 269         $offset -= 1;                   ## because $args->{OFFSET} 1 = record #1
 270         chomp (my $bibid = $bib_list[$offset]); ## Not sure about this
 271                 ## print "the bibid is:$bibid\n";
 272                 my $MARCRecord = &MARCgetbiblio($dbh,$bibid);
 273                 my $recordstring=$MARCRecord->as_usmarc();
 274                 ## print "here is my record: $recordstring\n";
 275
 276                 ## Troubleshooting:
 277                 ## use Data::Dumper;
 278                 ## Dumper $recordstring;
 279                 ## open (MARC, ">/root/marc.dump");
 280                 ## print MARC "$recordstring";
 281                 ## close MARC;
 282
 283                 ## Convert from 852/4 to 952:
 284                 ## 942a --> 852a  Organization code
 285                 ## 952b --> 852b  Home branch
 286                 ## 942k --> 852h  Classification
 287                 ## 952p --> 852p  Barcode
 288
 289 my $record = MARC::Record->new_from_usmarc($recordstring);
 290     my @fields942 = $record->field('942');
 291     my $field842 = $fields942[0];
 292         my ($field952, $sub852a, $sub852k, $sub852b, $sub852p, $sub852h);
 293
 294
 295 ## while ( my $record = $batch->next() ) {
 296   ##  my @fields942 = $record->field('942');
 297   ##  my $field842 = $fields942[0];
 298   ##     #grab first 942 (only need one, they are same for all items)
 299   ##  my $sub852a = ($field842->subfield('a') || '');
 300   ##  my $sub852h = ($field842->subfield('k') || '');
 301
 302   ##  my @fields952 = $record->field('952');
 303   ##  foreach my $field952 (@fields952) {   #get all 952s
 304   ##      my $sub852b = ($field952->subfield('b') || '');
 305   ##      my $sub852p = ($field952->subfield('p') || '');
 306
 307
 308 #grab first 942 (only need one, they are same for all items)
 309         unless (! $field952){
 310                 $sub852a = ($field952->subfield('a') || '') ;
 311 }
 312         unless (! $field952){ #->subfield('k')) {
 313                 $sub852k = ($field952->subfield('k') || '') ;
 314
 315 }
 316
 317     my @fields952 = $record->field('952');
 318     foreach my $field952 (@fields952) {   #get all 952s
 319
 320         unless (! $field952) { #->subfield('b')) {
 321                 $sub852b = ($field952->subfield('b') || '') ;
 322 }
 323  unless (! $field952) { #->subfield('p')) {
 324                 $sub852p = ($field952->subfield('p') || '') ;
 325 }
 326      #make it one big happy family
 327         my $new852 = MARC::Field->new(
 328                                       852,'','',
 329                                       'a' => $sub852a,
 330                                       'b' => $sub852b,
 331                                       'h' => $sub852h,
 332                                       'p' => $sub852p,
 333                                       );
 334         $record->append_fields($new852);
 335
 336 }
 337
 338 my $recordstringdone = $record->as_usmarc();
 339
 340                 ## Set the REP_FORM
 341                 $args->{REP_FORM} = &Net::Z3950::OID::usmarc;
 342
 343                 ## Return the record string to the client
 344                 $args->{RECORD} = $recordstringdone;
 345
 346 }
 347
 348 # That's all folks!
 349 #
 350 # OLD OLD OLD OLD
 351
 352 sub fetch_handler_old {
 353         my ($args) = @_;
 354         # warn "in fetch_handler";      ## troubleshooting
 355         my $offset = $args->{OFFSET};
 356         $offset -= 1;                   ## because $args->{OFFSET} 1 = record #1
 357         chomp (my $bibid = $bib_list[$offset]); ## Not sure about this
 358         my $sql_query = "SELECT tag, subfieldcode, subfieldvalue FROM marc_subfield_table where bibid=?";
 359         my $sth_get = $dbh->prepare("$sql_query");
 360         $sth_get->execute($bibid);
 361
 362         ## create a MARC::Record object
 363         my $rec = MARC::Record->new();
 364
 365         ## create the fields
 366         while (my @data=$sth_get->fetchrow_array) {
 367
 368                 my $tag = $data[0];
 369                 my $subfieldcode = $data[1];
 370                 my $subfieldvalue = $data[2];
 371
 372                 my $field = MARC::Field->new(
 373                                                   $tag,'','',
 374                                                   $subfieldcode => $subfieldvalue,
 375                                             );
 376
 377                 $rec->append_fields($field);
 378
 379                 ## build the marc string and put into $record
 380                 my $tmp_record = $rec->as_usmarc();
 381                 my $reclen = length $tmp_record;
 382                 my $baseaddr = "$reclen + dirlen";
 383 #               set_leader_lengths($reclen,$baseaddr);
 384                 my $record = $rec->as_usmarc();
 385                 $args->{RECORD} = $record;
 386         }
 387
 388 }
 389
 390
 391 ## This stuff doesn't work yet...I should include boolean searching someday
 392 ## though
 393 package Net::Z3950::RPN::Term;
 394 sub render {
 395     my $self = shift;
 396     return '"' . $self->{term} . '"';
 397 }
 398
 399 package Net::Z3950::RPN::And;
 400 sub render {
 401     my $self = shift;
 402     return '(' . $self->[0]->render() . ' AND ' .
 403                  $self->[1]->render() . ')';
 404 }
 405
 406 package Net::Z3950::RPN::Or;
 407 sub render {
 408     my $self = shift;
 409     return '(' . $self->[0]->render() . ' OR ' .
 410                  $self->[1]->render() . ')';
 411 }
 412
 413 package Net::Z3950::RPN::AndNot;
 414 sub render {
 415     my $self = shift;
 416     return '(' . $self->[0]->render() . ' ANDNOT ' .
 417                  $self->[1]->render() . ')';
 418 }