[Koha-cvs] CVS: koha/z3950/server zed-koha-server.pl,NONE,1.1

[Joshua Ferraro]

Update of /cvsroot/koha/koha/z3950/server
In directory sc8-pr-cvs1:/tmp/cvs-serv4019

Added Files:
        zed-koha-server.pl 
Log Message:
A basic Z3950 Server for Koha


--- NEW FILE ---
#!/usr/bin/perl -w
#
# Copyright 2000-2002 Katipo Communications
#
# This file is part of Koha.
#
# Koha is free software; you can redistribute it and/or modify it under the
# terms of the GNU General Public License as published by the Free Software
# Foundation; either version 2 of the License, or (at your option) any later
# version.
#
# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
# A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License along with
# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
# Suite 330, Boston, MA  02111-1307 USA
#
#-----------------------------------
# Script Name: npl-search.pl
# Script Version: 0.01
# Date:  2003/10/02
# Author:  Joshua Ferraro (address@hidden)
# Description: A very basic Z3950 Server 
# Usage: zed-koha-server.pl
# Revision History:
#    0.00  2003/08/14:  original version; search works
#    0.01  2003/10/02:  first functional version; search and fetch working
#                       records returned in USMARC (ISO2709) format     
#                       Bath compliant to Level 1 in Functional Areas A, B 
#-----------------------------------
# Note: After installing SimpleServer (indexdata.dk/simpleserver) and 
# changing the leader information in Koha's MARCgetbiblio subroutine in
# Biblio.pm you can run this script as root:
# ./zed-koha-server.pl
# and the server will start running on port 9999 and will allow searching
# and retrieval of records in MARC21
# ----------------------------------
use DBI;
use Net::Z3950::OID;
use Net::Z3950::SimpleServer;
use MARC::Record;
use C4::Context;
use C4::Biblio;
use strict;
my $dbh = C4::Context->dbh;
my @bib_list;           ## Stores the list of biblionumbers in a query 
                        ## I should eventually move this to different scope

my $handler = Net::Z3950::SimpleServer->new(INIT => \&init_handler,
                                            SEARCH => \&search_handler,
                                            FETCH => \&fetch_handler);

$handler->launch_server("npl-search.pl", @ARGV);

sub init_handler {
        my $args = shift;
        my $session = {};

        $args->{IMP_NAME} = "NPLKoha";
        $args->{IMP_VER} = "0.01";
        $args->{ERR_CODE} = 0;
        $args->{HANDLE} = $session;
        if (defined($args->{PASS}) && defined($args->{USER})) {
            printf("Received USER/PASS=%s/%s\n", $args->{USER},$args->{PASS});
        }

}


sub run_query {         ## Run the query and store the biblionumbers: 
        my ($sql_query, $query, $args) = @_;
        my $sth_get = $dbh->prepare("$sql_query");

        ## Send the query to the database:
        $sth_get->execute($query);
        my $count = 0;
        while(my ($data)=$sth_get->fetchrow_array) {
                
                ## Store Biblioitem info for later
                $bib_list[$count] = "$data";
  
                ## Implement count:
                $count ++;
        }
        $args->{HITS} = $count;
        print "got search: ", $args->{RPN}->{query}->render(), "\n";
}

sub search_handler {            
        my($args) = @_;
        ## Place the user's query into a variable 
        my $query = $args->{QUERY};
        
        ## The actual Term
        my $term = $args->{term};
        $term =~ s| |\%|g;
        $term .= "\%";         ## Add the wildcard to search term
        $term .= "\%";         ## Add the wildcard to search term
        $term = "\%" . "$term";

        $_ = "$query";
                   
                ## Strip out the junk and call the mysql query subroutine:
        if (/1=7/) {            ## isbn
                $query =~ s|address@hidden 1.2.840.10003.3.1 address@hidden 1=7 
||g;
                $query  =~ s|"||g;
                $query =~ s| |%|g;
        
                ## Bib-1 Structure Attributes:
                $query =~ s|address@hidden||g;

                $query =~ s|4=1||g;     ## Phrase
                $query =~ s|4=2||g;     ## Keyword
                $query =~ s|4=3||g;     ## Key 
                $query =~ s|4=4||g;     ## year 
                $query =~ s|4=5||g;     ## Date (normalized)
                $query =~ s|4=6||g;     ## word list
                $query =~ s|4=100||g;   ## date (un-normalized)
                $query =~ s|4=101||g;   ## name (normalized)    
                $query =~ s|4=102||g;   ## sme (un-normalized)
        
                $query =~ s|address@hidden ||g;
                $query =~ s|2=3||g;

                $query =~ s|,|%|g;      ## replace commas with wildcard
                $query .= "\%";         ## Add the wildcard to search term
                $query .= "\%";         ## Add the wildcard to search term
                print "The term was:\n";
                print "$term\n";        
                print "The query was:\n";        
                print "$query\n";
                my $sql_query = "SELECT biblionumber FROM biblioitems WHERE 
isbn LIKE ?";
                &run_query($sql_query, $query, $args);

        } 
        elsif (/1=1003/) {      ## author
                $query =~ s|address@hidden||g;
                $query =~ s|1.2.840.10003.3.1||g;
                $query =~ s|1=1003||g;
 
               ## Bib-1 Structure Attributes:
                $query =~ s|address@hidden ||g;

                $query =~ s|4=1||g;    ## Phrase
                $query =~ s|4=2||g;    ## Keyword
                $query =~ s|4=3||g;    ## Key
                $query =~ s|4=4||g;    ## year
                $query =~ s|4=5||g;    ## Date (normalized)
                $query =~ s|4=6||g;    ## word list
                $query =~ s|4=100||g;  ## date (un-normalized)
                $query =~ s|4=101||g;  ## name (normalized)
                $query =~ s|4=102||g;  ## sme (un-normalized)

                $query =~ s|2=3||g;
                $query =~ s|"||g;
                $query =~ s| |%|g;
                $query .= "\%";         ## Add the wildcard to search term
                print "$query\n";
                my $sql_query = "SELECT biblionumber FROM biblio WHERE author 
LIKE ?";
                &run_query($sql_query, $query, $args);
## used for debugging--works!
##              print "@bib_list\n";
        } 
        elsif (/1=4/) {         ## title
                $query =~ s|address@hidden||g;
                $query =~ s|1.2.840.10003.3.1||g;
                $query =~ s|1=4||g;
                $query  =~ s|"||g;
                $query  =~ s| |%|g;
                
                ## Bib-1 Structure Attributes:
                $query =~ s|address@hidden||g;

                $query =~ s|4=1||g;    ## Phrase
                $query =~ s|4=2||g;    ## Keyword
                $query =~ s|4=3||g;    ## Key
                $query =~ s|4=4||g;    ## year
                $query =~ s|4=5||g;    ## Date (normalized)
                $query =~ s|4=6||g;    ## word list
                $query =~ s|4=100||g;  ## date (un-normalized)
                $query =~ s|4=101||g;  ## name (normalized)
                $query =~ s|4=102||g;  ## sme (un-normalized)

                $query =~ s|2=3||g;
                #$query =~ s|address@hidden||g;
                $query .= "\%";         ## Add the wildcard to search term
                print "The term was:\n";
                print "$term\n";
                print "The query was:\n";
                print "$query\n";
                my $sql_query = "SELECT biblionumber FROM biblio WHERE title 
LIKE ?";
                &run_query($sql_query, $query, $args);
        }
        elsif (/1=21/) {         ## subject 
                $query =~ s|address@hidden 1.2.840.10003.3.1 address@hidden 
1=21 ||g;
                $query  =~ s|"||g;
                $query  =~ s| |%|g;
              
                ## Bib-1 Structure Attributes:
                $query =~ s|address@hidden ||g;

                $query =~ s|4=1||g;    ## Phrase
                $query =~ s|4=2||g;    ## Keyword
                $query =~ s|4=3||g;    ## Key
                $query =~ s|4=4||g;    ## year
                $query =~ s|4=5||g;    ## Date (normalized)
                $query =~ s|4=6||g;    ## word list
                $query =~ s|4=100||g;  ## date (un-normalized)
                $query =~ s|4=101||g;  ## name (normalized)
                $query =~ s|4=102||g;  ## sme (un-normalized)

                $query .= "\%";         ## Add the wildcard to search term
                print "$query\n";
                my $sql_query = "SELECT biblionumber FROM bibliosubject WHERE 
subject LIKE ?";
                &run_query($sql_query, $query, $args);
        }
        elsif (/1=1016/) {       ## any 
                $query =~ s|address@hidden 1.2.840.10003.3.1 address@hidden 
1=1016 ||g;
                $query  =~ s|"||g;
                $query  =~ s| |%|g;
                
                ## Bib-1 Structure Attributes:
                $query =~ s|address@hidden||g;

                $query =~ s|4=1||g;    ## Phrase
                $query =~ s|4=2||g;    ## Keyword
                $query =~ s|4=3||g;    ## Key
                $query =~ s|4=4||g;    ## year
                $query =~ s|4=5||g;    ## Date (normalized)
                $query =~ s|4=6||g;    ## word list
                $query =~ s|4=100||g;  ## date (un-normalized)
                $query =~ s|4=101||g;  ## name (normalized)
                $query =~ s|4=102||g;  ## sme (un-normalized)
               
                $query .= "\%";         ## Add the wildcard to search term
                print "$query\n";
                my $sql_query = "SELECT bibid FROM marc_word WHERE word LIKE?";
                &run_query($sql_query, $query, $args);
        }
}
sub fetch_handler {
        my ($args) = @_;
        # warn "in fetch_handler";      ## troubleshooting
        my $offset = $args->{OFFSET};
        $offset -= 1;                   ## because $args->{OFFSET} 1 = record #1
        chomp (my $bibid = $bib_list[$offset]); ## Not sure about this
                ## print "the bibid is:$bibid\n";
                my $MARCRecord = &MARCgetbiblio($dbh,$bibid);
                my $recordstring=$MARCRecord->as_usmarc();
                ## print "here is my record: $recordstring\n";

                ## Troubleshooting:
                ## use Data::Dumper;
                ## Dumper $recordstring;
                ## open (MARC, ">/root/marc.dump");
                ## print MARC "$recordstring";
                ## close MARC;
                
                ## Convert from 852/4 to 952:
                ## 942a --> 852a  Organization code
                ## 952b --> 852b  Home branch
                ## 942k --> 852h  Classification
                ## 952p --> 852p  Barcode

my $record = MARC::Record->new_from_usmarc($recordstring);
    my @fields942 = $record->field('942');
    my $field842 = $fields942[0];
        my ($field952, $sub852a, $sub852k, $sub852b, $sub852p, $sub852h);
       

## while ( my $record = $batch->next() ) {
  ##  my @fields942 = $record->field('942');
  ##  my $field842 = $fields942[0];
  ##     #grab first 942 (only need one, they are same for all items)
  ##  my $sub852a = ($field842->subfield('a') || '');
  ##  my $sub852h = ($field842->subfield('k') || '');

  ##  my @fields952 = $record->field('952');
  ##  foreach my $field952 (@fields952) {   #get all 952s
  ##      my $sub852b = ($field952->subfield('b') || '');
  ##      my $sub852p = ($field952->subfield('p') || '');


#grab first 942 (only need one, they are same for all items)
        unless (! $field952){
                $sub852a = ($field952->subfield('a') || '') ;
}
        unless (! $field952){ #->subfield('k')) { 
                $sub852k = ($field952->subfield('k') || '') ;

}

    my @fields952 = $record->field('952');
    foreach my $field952 (@fields952) {   #get all 952s
        
        unless (! $field952) { #->subfield('b')) { 
                $sub852b = ($field952->subfield('b') || '') ;
} 
 unless (! $field952) { #->subfield('p')) { 
                $sub852p = ($field952->subfield('p') || '') ;
}
     #make it one big happy family
        my $new852 = MARC::Field->new(
                                      852,'','',
                                      'a' => $sub852a,
                                      'b' => $sub852b,
                                      'h' => $sub852h,
                                      'p' => $sub852p,
                                      );
        $record->append_fields($new852);

}

my $recordstringdone = $record->as_usmarc();

                ## Set the REP_FORM
                $args->{REP_FORM} = &Net::Z3950::OID::usmarc;
                
                ## Return the record string to the client 
                $args->{RECORD} = $recordstringdone;

}

# That's all folks!
# 
# OLD OLD OLD OLD

sub fetch_handler_old {
        my ($args) = @_;        
        # warn "in fetch_handler";      ## troubleshooting
        my $offset = $args->{OFFSET};
        $offset -= 1;                   ## because $args->{OFFSET} 1 = record #1
        chomp (my $bibid = $bib_list[$offset]); ## Not sure about this
        my $sql_query = "SELECT tag, subfieldcode, subfieldvalue FROM 
marc_subfield_table where bibid=?";
        my $sth_get = $dbh->prepare("$sql_query");
        $sth_get->execute($bibid);
        
        ## create a MARC::Record object 
        my $rec = MARC::Record->new();

        ## create the fields
        while (my @data=$sth_get->fetchrow_array) {

                my $tag = $data[0];
                my $subfieldcode = $data[1];
                my $subfieldvalue = $data[2];

                my $field = MARC::Field->new(
                                                  $tag,'','',
                                                  $subfieldcode => 
$subfieldvalue,
                                            );

                $rec->append_fields($field);
                
                ## build the marc string and put into $record         
                my $tmp_record = $rec->as_usmarc();
                my $reclen = length $tmp_record;
                my $baseaddr = "$reclen + dirlen";
#               set_leader_lengths($reclen,$baseaddr);
                my $record = $rec->as_usmarc();         
                $args->{RECORD} = $record;
        }

}

        
## This stuff doesn't work yet...I should include boolean searching someday
## though
package Net::Z3950::RPN::Term;
sub render {
    my $self = shift;
    return '"' . $self->{term} . '"';
}

package Net::Z3950::RPN::And;
sub render {
    my $self = shift;
    return '(' . $self->[0]->render() . ' AND ' .
                 $self->[1]->render() . ')';
}

package Net::Z3950::RPN::Or;
sub render {
    my $self = shift;
    return '(' . $self->[0]->render() . ' OR ' .
                 $self->[1]->render() . ')';
}

package Net::Z3950::RPN::AndNot;
sub render {
    my $self = shift;
    return '(' . $self->[0]->render() . ' ANDNOT ' .
                 $self->[1]->render() . ')';
}