[Koha-cvs] koha/intranet/cgi-bin/z3950 search.pl zebraqueu... [rel_TG]
Tumer Garip
tgarip at neu.edu.tr
Sat Mar 10 02:33:07 CET 2007
CVSROOT: /sources/koha
Module name: koha
Branch: rel_TG
Changes by: Tumer Garip <tgarip1957> 07/03/10 01:33:07
Added files:
intranet/cgi-bin/z3950: search.pl zebraqueue_start.pl
zebraqueue_windows_start.pl
Log message:
fresh files for rel_TG
CVSWeb URLs:
http://cvs.savannah.gnu.org/viewcvs/koha/intranet/cgi-bin/z3950/search.pl?cvsroot=koha&only_with_tag=rel_TG&rev=1.1.2.1
http://cvs.savannah.gnu.org/viewcvs/koha/intranet/cgi-bin/z3950/zebraqueue_start.pl?cvsroot=koha&only_with_tag=rel_TG&rev=1.1.2.1
http://cvs.savannah.gnu.org/viewcvs/koha/intranet/cgi-bin/z3950/zebraqueue_windows_start.pl?cvsroot=koha&only_with_tag=rel_TG&rev=1.1.2.1
Patches:
Index: search.pl
===================================================================
RCS file: search.pl
diff -N search.pl
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ search.pl 10 Mar 2007 01:33:07 -0000 1.1.2.1
@@ -0,0 +1,224 @@
+#!/usr/bin/perl
+
+# 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
+
+use strict;
+use CGI;
+
+use C4::Auth;
+use C4::Interface::CGI::Output;
+use C4::Biblio;
+use C4::Context;
+use C4::Breeding;
+use MARC::File::USMARC;
+use MARC::File::XML;
+use ZOOM;
+use Encode;;
+
+my $input = new CGI;
+my $dbh = C4::Context->dbh;
+my $error = $input->param('error');
+my $oldbiblionumber=$input->param('oldbiblionumber');
+$oldbiblionumber=0 unless $oldbiblionumber;
+my $title = $input->param('title');
+my $author = $input->param('author');
+my $isbn = $input->param('isbn');
+my $issn = $input->param('issn');
+my $random = $input->param('random');
+my $op=$input->param('op');
+my $noconnection;
+my $numberpending;
+my $attr='';
+my $term;
+my $host;
+my $server;
+my $database;
+my $port;
+my $marcdata;
+my @encoding;
+my @results;
+my $count;
+my $toggle;
+my $record;
+my $oldbiblio;
+my $dbh = C4::Context->dbh;
+my $errmsg;
+my @serverloop=();
+my @serverhost;
+my @breeding_loop = ();
+
+unless ($random) { # this var is not useful anymore just kept to keep rel2_2 compatibility
+$random =rand(1000000000);
+}
+
+
+my ($template, $loggedinuser, $cookie)= get_template_and_user({template_name => "z3950/searchresult.tmpl",
+ query => $input,
+ type => "intranet",
+ authnotrequired => 1,
+ flagsrequired => {catalogue => 1},
+ debug => 1,
+ });
+
+if ($op ne "do_search"){
+
+my $sth=$dbh->prepare("select id,name,checked from z3950servers order by host");
+$sth->execute();
+while ($server=$sth->fetchrow_hashref) {
+my %temploop;
+$temploop{server}=$server->{name};
+$temploop{id}=$server->{id};
+$temploop{checked}=$server->{checked};
+push (@serverloop, \%temploop);
+}
+
+$template->param(isbn=>$isbn, issn=>$issn,title=>$title,author=>$author,
+ serverloop => \@serverloop,
+ opsearch => "search",
+ oldbiblionumber => $oldbiblionumber,
+ );
+output_html_with_http_headers $input, $cookie, $template->output;
+
+}else{
+
+my @id=$input->param('id');
+my @oConnection;
+my @oResult;
+my $s=0;
+ if ($isbn ne "/" || $issn ne "/") {
+ $attr='1=7';
+ $term=$isbn if ($isbn ne"/");
+ $term=$issn if ($issn ne"/");
+ } elsif ($title ne"/") {
+ $attr='1=4 @attr 4=1 ';
+ $term=$title;
+ } elsif ($author ne "/") {
+ $attr='1=1003';
+ $term=$author;
+ }
+
+
+my $query="\@attr $attr \"$term\"";
+
+ foreach my $servid ( @id){
+ my $sth=$dbh->prepare("select * from z3950servers where id=?");
+ $sth->execute($servid);
+
+ while ($server=$sth->fetchrow_hashref) {
+ my $noconnection=0;
+ #$numberpending=1;
+
+ my $option1=new ZOOM::Options();
+ $option1->option(async=>1);
+ $option1->option('elementSetName', 'F');
+ $option1->option('databaseName',$server->{db}) ;
+ $option1->option('user',$server->{userid}) ;
+ $option1->option('password',$server->{password}) ;
+ $option1->option('preferredRecordSyntax', $server->{syntax});
+ $oConnection[$s]=create ZOOM::Connection($option1);
+ $oConnection[$s]->connect($server->{host}, $server->{port});
+ $serverhost[$s]=$server->{name};
+ $encoding[$s]=$server->{syntax};
+ $s++;
+ }## while fetch
+
+ }# foreach
+my $nremaining = $s;
+my $firstresult=1;
+ for (my $z=0 ;$z<$s;$z++){
+$oResult[$z] = $oConnection[$z]->search_pqf($query);
+
+}
+AGAIN:
+ my $k;
+my $event;
+ while (($k = ZOOM::event(\@oConnection)) != 0) {
+ $event = $oConnection[$k-1]->last_event();
+# warn ("connection ", $k-1, ": event $event (", ZOOM::event_str($event), ")\n");
+ last if $event == ZOOM::Event::ZEND;
+ }
+if ($k != 0) {
+ $k--;
+#warn $serverhost[$k];
+ my($error, $errmsg, $addinfo, $diagset) = $oConnection[$k]->error_x();
+ if ($error) {
+
+# warn "$k $serverhost[$k] error $query: $errmsg ($error) $addinfo\n";
+ goto MAYBE_AGAIN;
+ }
+
+ my $numresults=$oResult[$k]->size() ;
+
+ my $i;
+ my $result='';
+ @breeding_loop = ();
+
+ if ($numresults>0){
+ for ($i=0; $i<(($numresults<5) ? ($numresults) : (5)) ; $i++) {
+ my $rec=$oResult[$k]->record($i);
+ my $marcrecord;
+ $marcdata = $rec->raw();
+ $marcrecord = MARC::File::USMARC::decode($marcdata);
+
+ my $marcxml=$marcrecord->as_xml_record($marcrecord);
+ $marcxml=Encode::encode('utf8',$marcxml);
+ #$marcxml=Encode::decode('utf8',$marcxml);
+ my $xmlhash=XML_xml2hash_onerecord($marcxml);
+ my $oldbiblio = XMLmarc2koha_onerecord($dbh,$xmlhash,'biblios');
+ $oldbiblio->{isbn} =~ s/ |-|\.//g,
+ $oldbiblio->{issn} =~ s/ |-|\.//g,
+
+my ($notmarcrecord,$alreadyindb,$alreadyinfarm,$imported,$bid)=ImportBreeding($marcdata,1,$serverhost[$k],$encoding[$k],$random);
+ my %row_data;
+ if ($i % 2) {
+ $toggle="#ffffcc";
+ } else {
+ $toggle="white";
+ }
+ $row_data{toggle} = $toggle;
+ $row_data{server} = $serverhost[$k];
+ $row_data{isbn} = $oldbiblio->{isbn};
+
+ $row_data{title} =$oldbiblio->{title};
+ $row_data{author} = $oldbiblio->{author};
+ $row_data{id} = $bid;
+ $row_data{oldbiblionumber}=$oldbiblionumber;
+ push (@breeding_loop, \%row_data);
+
+
+ }# upto 5 results
+ }#$numresults
+}# if $k !=0
+
+
+$numberpending=$nremaining-1;
+ $template->param(breeding_loop => \@breeding_loop,server=>$serverhost[$k],
+ numberpending => $numberpending,
+ );
+output_html_with_http_headers $input, "", $template->output if $firstresult==1;
+
+print $template->output if $firstresult !=1;
+$firstresult++;
+
+MAYBE_AGAIN:
+if (--$nremaining > 0) {
+ goto AGAIN;
+}
+$template->param( numberpending => "No",);
+print $template->output;
+} ## if op=search
Index: zebraqueue_start.pl
===================================================================
RCS file: zebraqueue_start.pl
diff -N zebraqueue_start.pl
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ zebraqueue_start.pl 10 Mar 2007 01:33:07 -0000 1.1.2.1
@@ -0,0 +1,62 @@
+#!/usr/bin/perl
+# script that starts the zebraquee
+# Written by TG on 01/08/2006
+use strict;
+
+
+use C4::Context;
+use C4::Biblio;
+use C4::AuthoritiesMarc;
+use XML::Simple;
+
+### ZEBRA SERVER UPDATER
+my $dbh=C4::Context->dbh;
+AGAIN:
+my $readsth=$dbh->prepare("select id,biblio_auth_number,operation,server from zebraqueue");
+my $delsth=$dbh->prepare("delete from zebraqueue where id =?");
+
+my $wait=C4::Context->preference('zebrawait');
+ $wait=120 unless $wait;
+my ($id,$biblionumber,$operation,$server,$marcxml);
+$readsth->execute;
+while (($id,$biblionumber,$operation,$server)=$readsth->fetchrow){
+if (!$biblionumber){
+$delsth->execute($id);
+next;
+}
+if ($server eq "biblioserver"){
+ ($marcxml) =ZEBRA_readyXML($dbh,$biblionumber);
+ }elsif($server eq "authorityserver"){
+ $marcxml =C4::AuthoritiesMarc::XMLgetauthority($dbh,$biblionumber);
+ }
+
+eval {
+my $hashed=XMLin($marcxml);
+}; ### is it a proper xml? broken xml may crash ZEBRA- slow but safe
+
+if ($@){
+warn $@;
+## Broken XML-- Should not reach here-- but if it does -lets protect ZEBRA
+$delsth->execute($id);
+next;
+}
+my $ok;
+eval{
+ $ok=ZEBRAopserver($marcxml,$operation,$server,$biblionumber);
+};
+ ## If a delete operation delete the SQL DB as well
+ if ($operation eq "recordDelete" ){
+ if ($server eq "biblioserver"){
+ ZEBRAdelbiblio($dbh,$biblionumber);
+ }elsif ($server eq "authorityserver"){
+ ZEBRAdelauthority($dbh,$biblionumber);
+ }
+ }
+$delsth->execute($id) if ($ok==1|| $operation eq "recordDelete" );
+
+}
+ZEBRAopcommit($server);
+$delsth->finish;
+$readsth->finish;
+sleep $wait;
+goto AGAIN;
\ No newline at end of file
Index: zebraqueue_windows_start.pl
===================================================================
RCS file: zebraqueue_windows_start.pl
diff -N zebraqueue_windows_start.pl
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ zebraqueue_windows_start.pl 10 Mar 2007 01:33:07 -0000 1.1.2.1
@@ -0,0 +1,32 @@
+#!/usr/bin/perl
+# script that starts the zebraquee
+# Written by TG on 01/08/2006
+use strict;
+
+use Win32::Process;
+use Win32;
+use C4::Context;
+use CGI;
+my $input=new CGI;
+my $pid;
+my $fileplace=C4::Context->config('intranetdir');
+my $fullpath=$fileplace."/cgi-bin/z3950";
+open(IN,"<" ,"C:/etc/zebra.pid") or goto NEW;
+while (<IN>){
+ $pid=$_;
+my $exitcode;
+Win32::Process::KillProcess($pid, $exitcode);
+}
+close(IN);
+
+NEW:
+my $ZebraObj;
+ my $ret=Win32::Process::Create($ZebraObj, "C:/usr/bin/perl.exe",'perl zebraqueue_start.pl', 0, DETACHED_PROCESS,$fullpath) ;
+$pid=$ZebraObj->GetProcessID();
+
+open(OUT,">" ,"C:/etc/zebra.pid");
+print OUT $pid;
+close(OUT);
+print $input->redirect("/cgi-bin/koha/mainpage.pl?pid=$pid");
+1;
+
More information about the Koha-cvs
mailing list