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: 0.02
  23 # Date:  2004/04/14
  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 #-----------------------------------
  35 # Note: After installing SimpleServer (indexdata.dk/simpleserver) and
  36 # changing the leader information in Koha's MARCgetbiblio subroutine in
  37 # Biblio.pm you can run this script as root:
  38 #
  39 # ./zed-koha-server.pl
  40 #
  41 # and the server will start running on port 9999 and will allow searching
  42 # and retrieval of records in MARC21 (USMARC; ISO2709) bibliographic format.
  43 # ----------------------------------
  44 use DBI;
  45 use Net::Z3950::OID;
  46 use Net::Z3950::SimpleServer;
  47 use MARC::Record;
  48 use C4::Context;
  49 use C4::Biblio;
  50 use strict;
  51 my $dbh = C4::Context->dbh;
  52 my @bib_list;           ## Stores the list of biblionumbers in a query
  53                         ## I should eventually move this to different scope
  54
  55 my $handler = Net::Z3950::SimpleServer->new(INIT => \&init_handler,
  56                                             SEARCH => \&search_handler,
  57                                             FETCH => \&fetch_handler);
  58
  59 $handler->launch_server("zed-koha-server.pl", @ARGV);
  60
  61 sub init_handler {
  62         my $args = shift;
  63         my $session = {};
  64
  65         # FIXME: I should force use of my database name
  66         $args->{IMP_NAME} = "Zed-Koha";
  67         $args->{IMP_VER} = "0.02";
  68         $args->{ERR_CODE} = 0;
  69         $args->{HANDLE} = $session;
  70         if (defined($args->{PASS}) && defined($args->{USER})) {
  71             printf("Received USER/PASS=%s/%s\n", $args->{USER},$args->{PASS});
  72         }
  73
  74 }
  75
  76
  77 sub run_query {         ## Run the query and store the biblionumbers:
  78         my ($sql_query, $query, $args) = @_;
  79         my $sth_get = $dbh->prepare("$sql_query");
  80
  81         ## Send the query to the database:
  82         $sth_get->execute($query);
  83         my $count = 0;
  84         while(my ($data)=$sth_get->fetchrow_array) {
  85
  86                 ## Store Biblioitem info for later
  87                 $bib_list[$count] = "$data";
  88
  89                 ## Implement count:
  90                 $count ++;
  91         }
  92         $args->{HITS} = $count;
  93         print "got search: ", $args->{RPN}->{query}->render(), "\n";
  94 }
  95
  96 sub search_handler {
  97         my($args) = @_;
  98         ## Place the user's query into a variable
  99         my $query = $args->{QUERY};
 100
 101         ## The actual Term
 102         my $term = $args->{term};
 103         $term =~ s| |\%|g;
 104         $term .= "\%";         ## Add the wildcard to search term
 105
 106         $_ = "$query";
 107
 108                 ## Strip out the junk and call the mysql query subroutine:
 109         if (/1=7/) {            ## isbn
 110                 $query =~ s|\@attrset 1.2.840.10003.3.1 \@attr 1=7 ||g;
 111                 $query  =~ s|"||g;
 112                 $query =~ s| |%|g;
 113
 114                 ## Bib-1 Structure Attributes:
 115                 $query =~ s|\@attr||g;
 116
 117                 $query =~ s|4=1||g;     ## Phrase
 118                 $query =~ s|4=2||g;     ## Keyword
 119                 $query =~ s|4=3||g;     ## Key
 120                 $query =~ s|4=4||g;     ## year
 121                 $query =~ s|4=5||g;     ## Date (normalized)
 122                 $query =~ s|4=6||g;     ## word list
 123                 $query =~ s|4=100||g;   ## date (un-normalized)
 124                 $query =~ s|4=101||g;   ## name (normalized)
 125                 $query =~ s|4=102||g;   ## sme (un-normalized)
 126
 127                 $query =~ s|\@and ||g;
 128                 $query =~ s|2=3||g;
 129
 130                 $query =~ s|,|%|g;      ## replace commas with wildcard
 131                 $query .= "\%";         ## Add the wildcard to search term
 132                 $query .= "\%";         ## Add the wildcard to search term
 133                 print "The term was:\n";
 134                 print "$term\n";
 135                 print "The query was:\n";
 136                 print "$query\n";
 137                 my $sql_query = "SELECT biblionumber FROM biblioitems WHERE isbn LIKE ?";
 138                 &run_query($sql_query, $query, $args);
 139
 140         }
 141         elsif (/1=1003/) {      ## author
 142                 $query =~ s|\@attrset||g;
 143                 $query =~ s|1.2.840.10003.3.1||g;
 144                 $query =~ s|1=1003||g;
 145
 146                ## Bib-1 Structure Attributes:
 147                 $query =~ s|\@attr ||g;
 148
 149                 $query =~ s|4=1||g;    ## Phrase
 150                 $query =~ s|4=2||g;    ## Keyword
 151                 $query =~ s|4=3||g;    ## Key
 152                 $query =~ s|4=4||g;    ## year
 153                 $query =~ s|4=5||g;    ## Date (normalized)
 154                 $query =~ s|4=6||g;    ## word list
 155                 $query =~ s|4=100||g;  ## date (un-normalized)
 156                 $query =~ s|4=101||g;  ## name (normalized)
 157                 $query =~ s|4=102||g;  ## sme (un-normalized)
 158
 159                 $query =~ s|2=3||g;
 160                 $query =~ s|"||g;
 161                 $query =~ s| |%|g;
 162                 $query .= "\%";         ## Add the wildcard to search term
 163                 print "$query\n";
 164                 my $sql_query = "SELECT biblionumber FROM biblio WHERE author LIKE ?";
 165                 &run_query($sql_query, $query, $args);
 166 ## used for debugging--works!
 167 ##              print "@bib_list\n";
 168         }
 169         elsif (/1=4/) {         ## title
 170                 $query =~ s|\@attrset||g;
 171                 $query =~ s|1.2.840.10003.3.1||g;
 172                 $query =~ s|1=4||g;
 173                 $query  =~ s|"||g;
 174                 $query  =~ s| |%|g;
 175
 176                 ## Bib-1 Structure Attributes:
 177                 $query =~ s|\@attr||g;
 178
 179                 $query =~ s|4=1||g;    ## Phrase
 180                 $query =~ s|4=2||g;    ## Keyword
 181                 $query =~ s|4=3||g;    ## Key
 182                 $query =~ s|4=4||g;    ## year
 183                 $query =~ s|4=5||g;    ## Date (normalized)
 184                 $query =~ s|4=6||g;    ## word list
 185                 $query =~ s|4=100||g;  ## date (un-normalized)
 186                 $query =~ s|4=101||g;  ## name (normalized)
 187                 $query =~ s|4=102||g;  ## sme (un-normalized)
 188
 189                 $query =~ s|2=3||g;
 190                 #$query =~ s|\@and||g;
 191                 $query .= "\%";         ## Add the wildcard to search term
 192                 print "The term was:\n";
 193                 print "$term\n";
 194                 print "The query was:\n";
 195                 print "$query\n";
 196                 my $sql_query = "SELECT biblionumber FROM biblio WHERE title LIKE ?";
 197                 &run_query($sql_query, $query, $args);
 198         }
 199         elsif (/1=21/) {         ## subject
 200                 $query =~ s|\@attrset 1.2.840.10003.3.1 \@attr 1=21 ||g;
 201                 $query  =~ s|"||g;
 202                 $query  =~ s| |%|g;
 203
 204                 ## Bib-1 Structure Attributes:
 205                 $query =~ s|\@attr ||g;
 206
 207                 $query =~ s|4=1||g;    ## Phrase
 208                 $query =~ s|4=2||g;    ## Keyword
 209                 $query =~ s|4=3||g;    ## Key
 210                 $query =~ s|4=4||g;    ## year
 211                 $query =~ s|4=5||g;    ## Date (normalized)
 212                 $query =~ s|4=6||g;    ## word list
 213                 $query =~ s|4=100||g;  ## date (un-normalized)
 214                 $query =~ s|4=101||g;  ## name (normalized)
 215                 $query =~ s|4=102||g;  ## sme (un-normalized)
 216
 217                 $query .= "\%";         ## Add the wildcard to search term
 218                 print "$query\n";
 219                 my $sql_query = "SELECT biblionumber FROM bibliosubject WHERE subject LIKE ?";
 220                 &run_query($sql_query, $query, $args);
 221         }
 222         elsif (/1=1016/) {       ## any
 223                 $query =~ s|\@attrset 1.2.840.10003.3.1 \@attr 1=1016 ||g;
 224                 $query  =~ s|"||g;
 225                 $query  =~ s| |%|g;
 226
 227                 ## Bib-1 Structure Attributes:
 228                 $query =~ s|\@attr||g;
 229
 230                 $query =~ s|4=1||g;    ## Phrase
 231                 $query =~ s|4=2||g;    ## Keyword
 232                 $query =~ s|4=3||g;    ## Key
 233                 $query =~ s|4=4||g;    ## year
 234                 $query =~ s|4=5||g;    ## Date (normalized)
 235                 $query =~ s|4=6||g;    ## word list
 236                 $query =~ s|4=100||g;  ## date (un-normalized)
 237                 $query =~ s|4=101||g;  ## name (normalized)
 238                 $query =~ s|4=102||g;  ## sme (un-normalized)
 239
 240                 $query .= "\%";         ## Add the wildcard to search term
 241                 print "$query\n";
 242                 my $sql_query = "SELECT bibid FROM marc_word WHERE word LIKE?";
 243                 &run_query($sql_query, $query, $args);
 244         }
 245 }
 246 sub fetch_handler {
 247         my ($args) = @_;
 248         # warn "in fetch_handler";      ## troubleshooting
 249         my $offset = $args->{OFFSET};
 250         $offset -= 1;                   ## because $args->{OFFSET} 1 = record #1
 251         chomp (my $bibid = $bib_list[$offset]); ## Not sure about this
 252                 ## print "the bibid is:$bibid\n";
 253                 my $MARCRecord = &MARCgetbiblio($dbh,$bibid);
 254                 my $recordstring=$MARCRecord->as_usmarc();
 255                 ## print "here is my record: $recordstring\n";
 256
 257                 ## Troubleshooting:
 258                 ## use Data::Dumper;
 259                 ## Dumper $recordstring;
 260                 ## open (MARC, ">/root/marc.dump");
 261                 ## print MARC "$recordstring";
 262                 ## close MARC;
 263
 264                 ## Convert from 852/4 to 952:
 265                 ## 942a --> 852a  Organization code
 266                 ## 952b --> 852b  Home branch
 267                 ## 942k --> 852h  Classification
 268                 ## 952p --> 852p  Barcode
 269
 270 my $record = MARC::Record->new_from_usmarc($recordstring);
 271     my @fields942 = $record->field('942');
 272     my $field842 = $fields942[0];
 273         my ($field952, $sub852a, $sub852k, $sub852b, $sub852p, $sub852h);
 274
 275
 276 ## while ( my $record = $batch->next() ) {
 277   ##  my @fields942 = $record->field('942');
 278   ##  my $field842 = $fields942[0];
 279   ##     #grab first 942 (only need one, they are same for all items)
 280   ##  my $sub852a = ($field842->subfield('a') || '');
 281   ##  my $sub852h = ($field842->subfield('k') || '');
 282
 283   ##  my @fields952 = $record->field('952');
 284   ##  foreach my $field952 (@fields952) {   #get all 952s
 285   ##      my $sub852b = ($field952->subfield('b') || '');
 286   ##      my $sub852p = ($field952->subfield('p') || '');
 287
 288
 289 #grab first 942 (only need one, they are same for all items)
 290         unless (! $field952){
 291                 $sub852a = ($field952->subfield('a') || '') ;
 292 }
 293         unless (! $field952){ #->subfield('k')) {
 294                 $sub852k = ($field952->subfield('k') || '') ;
 295
 296 }
 297
 298     my @fields952 = $record->field('952');
 299     foreach my $field952 (@fields952) {   #get all 952s
 300
 301         unless (! $field952) { #->subfield('b')) {
 302                 $sub852b = ($field952->subfield('b') || '') ;
 303 }
 304  unless (! $field952) { #->subfield('p')) {
 305                 $sub852p = ($field952->subfield('p') || '') ;
 306 }
 307      #make it one big happy family
 308         my $new852 = MARC::Field->new(
 309                                       852,'','',
 310                                       'a' => $sub852a,
 311                                       'b' => $sub852b,
 312                                       'h' => $sub852h,
 313                                       'p' => $sub852p,
 314                                       );
 315         $record->append_fields($new852);
 316
 317 }
 318
 319 my $recordstringdone = $record->as_usmarc();
 320
 321                 ## Set the REP_FORM
 322                 $args->{REP_FORM} = &Net::Z3950::OID::usmarc;
 323
 324                 ## Return the record string to the client
 325                 $args->{RECORD} = $recordstringdone;
 326
 327 }
 328
 329 # That's all folks!
 330 #
 331 # OLD OLD OLD OLD
 332
 333 sub fetch_handler_old {
 334         my ($args) = @_;
 335         # warn "in fetch_handler";      ## troubleshooting
 336         my $offset = $args->{OFFSET};
 337         $offset -= 1;                   ## because $args->{OFFSET} 1 = record #1
 338         chomp (my $bibid = $bib_list[$offset]); ## Not sure about this
 339         my $sql_query = "SELECT tag, subfieldcode, subfieldvalue FROM marc_subfield_table where bibid=?";
 340         my $sth_get = $dbh->prepare("$sql_query");
 341         $sth_get->execute($bibid);
 342
 343         ## create a MARC::Record object
 344         my $rec = MARC::Record->new();
 345
 346         ## create the fields
 347         while (my @data=$sth_get->fetchrow_array) {
 348
 349                 my $tag = $data[0];
 350                 my $subfieldcode = $data[1];
 351                 my $subfieldvalue = $data[2];
 352
 353                 my $field = MARC::Field->new(
 354                                                   $tag,'','',
 355                                                   $subfieldcode => $subfieldvalue,
 356                                             );
 357
 358                 $rec->append_fields($field);
 359
 360                 ## build the marc string and put into $record
 361                 my $tmp_record = $rec->as_usmarc();
 362                 my $reclen = length $tmp_record;
 363                 my $baseaddr = "$reclen + dirlen";
 364 #               set_leader_lengths($reclen,$baseaddr);
 365                 my $record = $rec->as_usmarc();
 366                 $args->{RECORD} = $record;
 367         }
 368
 369 }
 370
 371
 372 ## This stuff doesn't work yet...I should include boolean searching someday
 373 ## though
 374 package Net::Z3950::RPN::Term;
 375 sub render {
 376     my $self = shift;
 377     return '"' . $self->{term} . '"';
 378 }
 379
 380 package Net::Z3950::RPN::And;
 381 sub render {
 382     my $self = shift;
 383     return '(' . $self->[0]->render() . ' AND ' .
 384                  $self->[1]->render() . ')';
 385 }
 386
 387 package Net::Z3950::RPN::Or;
 388 sub render {
 389     my $self = shift;
 390     return '(' . $self->[0]->render() . ' OR ' .
 391                  $self->[1]->render() . ')';
 392 }
 393
 394 package Net::Z3950::RPN::AndNot;
 395 sub render {
 396     my $self = shift;
 397     return '(' . $self->[0]->render() . ' ANDNOT ' .
 398                  $self->[1]->render() . ')';
 399 }