[Koha-cvs] koha currency.pl koha.conf.in koha.t logout.pl ...
paul poulain
paul at koha-fr.org
Fri Mar 9 16:26:52 CET 2007
CVSROOT: /sources/koha
Module name: koha
Changes by: paul poulain <tipaul> 07/03/09 15:26:52
Removed files:
. : currency.pl koha.conf.in koha.t logout.pl
mainpage.pl Makefile.PL plugin_launcher.pl
search-test.pl
z3950 : search.pl zebraqueue_start.pl
zebraqueue_windows_start.pl
Log message:
rel_3_0 moved to HEAD (removing useless file)
CVSWeb URLs:
http://cvs.savannah.gnu.org/viewcvs/koha/currency.pl?cvsroot=koha&r1=1.9&r2=0
http://cvs.savannah.gnu.org/viewcvs/koha/koha.conf.in?cvsroot=koha&r1=1.1&r2=0
http://cvs.savannah.gnu.org/viewcvs/koha/koha.t?cvsroot=koha&r1=1.1&r2=0
http://cvs.savannah.gnu.org/viewcvs/koha/logout.pl?cvsroot=koha&r1=1.6&r2=0
http://cvs.savannah.gnu.org/viewcvs/koha/mainpage.pl?cvsroot=koha&r1=1.12&r2=0
http://cvs.savannah.gnu.org/viewcvs/koha/Makefile.PL?cvsroot=koha&r1=1.8&r2=0
http://cvs.savannah.gnu.org/viewcvs/koha/plugin_launcher.pl?cvsroot=koha&r1=1.4&r2=0
http://cvs.savannah.gnu.org/viewcvs/koha/search-test.pl?cvsroot=koha&r1=1.1&r2=0
http://cvs.savannah.gnu.org/viewcvs/koha/z3950/search.pl?cvsroot=koha&r1=1.8&r2=0
http://cvs.savannah.gnu.org/viewcvs/koha/z3950/zebraqueue_start.pl?cvsroot=koha&r1=1.1&r2=0
http://cvs.savannah.gnu.org/viewcvs/koha/z3950/zebraqueue_windows_start.pl?cvsroot=koha&r1=1.1&r2=0
Patches:
Index: currency.pl
===================================================================
RCS file: currency.pl
diff -N currency.pl
--- currency.pl 27 Jul 2006 14:02:47 -0000 1.9
+++ /dev/null 1 Jan 1970 00:00:00 -0000
@@ -1,42 +0,0 @@
-#!/usr/bin/perl
-
-# $Id: currency.pl,v 1.9 2006/07/27 14:02:47 toins Exp $
-
-#written by chris at katipo.co.nz
-#9/10/2000
-#script to display and update currency rates
-
-
-# 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 CGI;
-use C4::Acquisition;
-use C4::Biblio;
-use C4::Bookfund;
-
-my $input=new CGI;
-
-my @params=$input->param;
-foreach my $param (@params){
- if ($param ne 'type' && $param !~ /submit/){
- my $data=$input->param($param);
- warn "$data / $param";
- ModCurrencies($param,$data);
-}
-}
-print $input->redirect('/cgi-bin/koha/acqui/acqui-home.pl');
Index: koha.conf.in
===================================================================
RCS file: koha.conf.in
diff -N koha.conf.in
--- koha.conf.in 30 Oct 2002 14:06:54 -0000 1.1
+++ /dev/null 1 Jan 1970 00:00:00 -0000
@@ -1,16 +0,0 @@
-# koha.conf
-# This is the Koha configuration file.
-
-# $Id: koha.conf.in,v 1.1 2002/10/30 14:06:54 arensb Exp $
-
-# Database access
-database = @db_name@
-hostname = @db_host@
-user = @db_user@
-pass = @db_passwd@
-
-# XXX
-#includes =
-#opachtdocs =
-#intrahtdocs =
-#templatedirectory =
Index: koha.t
===================================================================
RCS file: koha.t
diff -N koha.t
--- koha.t 8 Apr 2002 23:44:43 -0000 1.1
+++ /dev/null 1 Jan 1970 00:00:00 -0000
@@ -1,14 +0,0 @@
-BEGIN { $| = 1; print "1..2\n"; }
-END {print "not ok 1\n" unless $loaded;}
-use C4::Koha;
-$loaded = 1;
-print "ok 1\n";
-
-$date = "01/01/2002";
-$newdate = &slashifyDate("2002-01-01");
-
-if ($date eq $newdate) {
- print "ok 2\n";
-} else {
- print "not ok 2\n";
-}
Index: logout.pl
===================================================================
RCS file: logout.pl
diff -N logout.pl
--- logout.pl 27 Sep 2006 21:19:22 -0000 1.6
+++ /dev/null 1 Jan 1970 00:00:00 -0000
@@ -1,75 +0,0 @@
-#!/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 CGI;
-use C4::Context;
-
-my $query=new CGI;
-
-my $sessionID=$query->cookie('sessionID');
-
-my $sessions;
-open (S, "/tmp/sessions");
-while (my ($sid, $u, $lasttime) = split(/:/, <S>)) {
- chomp $lasttime;
- (next) unless ($sid);
- (next) if ($sid eq $sessionID);
- $sessions->{$sid}->{'userid'}=$u;
- $sessions->{$sid}->{'lasttime'}=$lasttime;
-}
-open (S, ">/tmp/sessions");
-foreach (keys %$sessions) {
- my $userid=$sessions->{$_}->{'userid'};
- my $lasttime=$sessions->{$_}->{'lasttime'};
- print S "$_:$userid:$lasttime\n";
-}
-
-my $dbh = C4::Context->dbh;
-
-# Check that this is the ip that created the session before deleting it
-
-my $sth=$dbh->prepare("select userid,ip from sessions where sessionID=?");
-$sth->execute($sessionID);
-my ($userid, $ip);
-if ($sth->rows) {
- ($userid,$ip) = $sth->fetchrow;
- if ($ip ne $ENV{'REMOTE_ADDR'}) {
- # attempt to logout from a different ip than cookie was created at
- exit;
- }
-}
-
-$sth=$dbh->prepare("delete from sessions where sessionID=?");
-$sth->execute($sessionID);
-open L, ">>/tmp/sessionlog";
-my $time=localtime(time());
-printf L "%20s from %16s logged out at %30s (manual log out).\n", $userid, $ip, $time;
-close L;
-
-my $cookie=$query->cookie(-name => 'sessionID',
- -value => '',
- -expires => '+1y');
-
-# Should redirect to intranet home page after logging out
-
-print $query->redirect("mainpage.pl");
-exit;
-
-
Index: mainpage.pl
===================================================================
RCS file: mainpage.pl
diff -N mainpage.pl
--- mainpage.pl 27 Sep 2006 21:19:22 -0000 1.12
+++ /dev/null 1 Jan 1970 00:00:00 -0000
@@ -1,41 +0,0 @@
-#!/usr/bin/perl
-use strict;
-use C4::Interface::CGI::Output;
-use CGI;
-use C4::Auth;
-use C4::Suggestions;
-use C4::Koha;
-use C4::BookShelves;
-use C4::NewsChannels;
-
-my $query = new CGI;
-my ($template, $loggedinuser, $cookie)
- = get_template_and_user({template_name => "intranet-main.tmpl",
- query => $query,
- type => "intranet",
- authnotrequired => 0,
- flagsrequired => {catalogue => 1, circulate => 1,
- parameters => 1, borrowers => 1,
- permissions =>1, reserveforothers=>1,
- editcatalogue => 1, updatecharges => 1, },
- debug => 1,
- });
-
-my $lang = "koha";
-my $error=$query->param('error');
-$template->param(error =>$error);
-my ($opac_news_count, $all_opac_news) = &get_opac_news(undef, $lang);
-# if ($opac_news_count > 4) {$template->param(more_opac_news => 1);}
-$template->param(opac_news => $all_opac_news);
-$template->param(opac_news_count => $opac_news_count);
-
-my $marc_p = C4::Context->boolean_preference("marc");
-$template->param(NOTMARC => !$marc_p);
-my $new_suggestions = &CountSuggestion("ASKED");
-$template->param(new_suggestions => $new_suggestions);
-
-
-my $count_pending_request = CountShelfRequest(undef, "PENDING");
-$template->param(count_pending_request => $count_pending_request);
-output_html_with_http_headers $query, $cookie, $template->output();
-
Index: Makefile.PL
===================================================================
RCS file: Makefile.PL
diff -N Makefile.PL
--- Makefile.PL 12 Sep 2006 21:51:06 -0000 1.8
+++ /dev/null 1 Jan 1970 00:00:00 -0000
@@ -1,93 +0,0 @@
-# Copyright 2005 MJ Ray and koha development team
-#
-# 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
-#
-# Current maintainer MJR slef at users.sourceforge.net
-# See http://www.koha.org/wiki/?page=KohaInstaller
-
-use ExtUtils::MakeMaker;
-
-die "perl 5.6.1 or later required" unless ($] >= 5.006001);
-
-WriteMakefile(
- NAME => 'Koha',
- DISTNAME => 'koha',
- VERSION => '3.2.0',
- NO_META => 1,
- PREREQ_PM => {
- 'DBI' => 1,
- 'Date::Manip' => 1,
- 'DBD::MySQL' => 1,
- 'HTML::Template::Pro' => 1,
- 'Digest::MD5' => 1,
- 'MARC::Record' => 2.0,
- 'MARC::Charset' => 0.95,
- 'MARC::File::XML' => 0.83,
- 'Mail::Sendmail' => 1,
- 'PDF::API2' => 1,
- 'Net::LDAP' => 1,
- XML::Simple=>1,
- 'XML::LibXML' => 1.58
- },
- CONFIGURE => sub {
- # Figure out options here?
- return { macro => { 'export TEST' => '755' } }
- },
- PMLIBDIRS => [ '.' ],
- PL_FILES => { # generator => target
- 'opac/getfromintranet.PL' => ['$(INST_LIBDIR)/opac/cgi-bin/detail.pl','$(INST_LIBDIR)/opac/cgi-bin/moredetail.pl','$(INST_LIBDIR)/opac/cgi-bin/search.pl','$(INST_LIBDIR)/opac/cgi-bin/subjectsearch.pl','$(INST_LIBDIR)/opac/cgi-bin/logout.pl'],
- 'misc/koha.conf.PL' => '$(INST_LIBDIR)/../etc/koha.conf',
- 'misc/apache-koha.conf.PL' => '$(INST_LIBDIR)/../etc/apache-koha.conf',
- 'misc/koha.sql.PL' => '$(INST_LIBDIR)/intranet/scripts/koha.sql',
- 'z3950/z3950-daemon-options.PL' => '$(INST_LIBDIR)/intranet/scripts/z3950daemon/z3950-daemon-options',
- # fake target to check permissions
- 'misc/chmod.PL' => '$(INST_LIBDIR)/fake-target'
- }
- # need to set ownerships
- # need to load koha.sql
- # need to link koha-httpd.conf
- # need to start z3950-daemon
-);
-
-sub MY::libscan {
- my ($self,$path) = @_;
-
- # set up the recursion
- if (-d $path) { 1; }
- elsif ($path !~ /\//) { $path = ''; }
- # from here
- # reimplementation of buildrelease and Install::installfiles
- # ban some shell specials too
- elsif ($path =~ /(\/CVS\/|\.(bak|orig|PL)$|\/,|\/t\/|[^\$]\(| )/) { $path = ''; }
- elsif (
- $path =~ s:\)/misc:\)/intranet/scripts: ||
- $path =~ s:\)/updater:\)/intranet/scripts/updater: ||
- $path =~ s:\)/z3950/(processz3950queue|.*sh):\)/intranet/scripts/z3950daemon/\1: ||
- $path =~ s:\)/z3950:\)/intranet/cgi-bin/z3950: ||
- $path =~ s:\)/koha-tmpl/intranet-tmpl:\)/intranet/htdocs/intranet-tmpl: ||
- $path =~ s:\)/koha-tmpl/intranet.html:\)/intranet/htdocs/index.html: ||
- $path =~ s:\)/koha-tmpl/opac-tmpl:\)/opac/htdocs/opac-tmpl: ||
- $path =~ s:\)/koha-tmpl/opac.html:\)/opac/htdocs/index.html: ||
- $path =~ s:\)/opac:\)/opac/cgi-bin:
- ) { 1; }
- elsif ($path !~ /\.p[lm]$/) { $path = ''; }
- elsif ($path !~ /\)\/C4/) { $path =~ s!/!/intranet/cgi-bin/!; }
-
- #print STDERR $path."\n";
-
- return($path);
-
- }
Index: plugin_launcher.pl
===================================================================
RCS file: plugin_launcher.pl
diff -N plugin_launcher.pl
--- plugin_launcher.pl 1 Mar 2005 13:40:47 -0000 1.4
+++ /dev/null 1 Jan 1970 00:00:00 -0000
@@ -1,40 +0,0 @@
-#!/usr/bin/perl
-
-# $Id: plugin_launcher.pl,v 1.4 2005/03/01 13:40:47 tipaul Exp $
-
-# 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::Context;
-use HTML::Template;
-use C4::Search;
-use C4::Output;
-
-my $input = new CGI;
-my $plugin_name=$input->param("plugin_name");
-my $plugin_name="value_builder/".$input->param("plugin_name");
-
-# opening plugin. Just check wether we are on a developper computer on a production one
-# (the cgidir differs)
-my $cgidir = C4::Context->intranetdir ."/cgi-bin";
-unless (opendir(DIR, "$cgidir/value_builder")) {
- $cgidir = C4::Context->intranetdir;
-}
-require $cgidir."/".$plugin_name;
-&plugin($input);
Index: search-test.pl
===================================================================
RCS file: search-test.pl
diff -N search-test.pl
--- search-test.pl 16 Feb 2006 20:51:07 -0000 1.1
+++ /dev/null 1 Jan 1970 00:00:00 -0000
@@ -1,42 +0,0 @@
-#!/usr/bin/perl
-
-# simple script to test cql searching
-# written by chris at katipo.co.nz 17/2/06
-
-use C4::Search;
-use C4::Auth;
-use C4::Interface::CGI::Output;
-
-use CGI;
-use Smart::Comments;
-use strict;
-use warnings;
-
-my $input = new CGI;
-
-my ( $template, $borrowernumber, $cookie ) = get_template_and_user(
- {
- template_name => "search-test.tmpl",
- type => "opac",
- query => $input,
- authnotrequired => 1,
- flagsrequired => { borrow => 1 },
- }
-);
-
-my $cql=$input->param('cql');
-if ($cql){
- my %search;
- $search{'cql'} = $cql;
- my $results = search( \%search, 'CQL' , 10);
- $template->param(CQL => 'yes'
- );
- $template->param(results => $results);
-}
-#my $record = get_record($result);
-
-
-
-
-
-output_html_with_http_headers $input, $cookie, $template->output;
Index: z3950/search.pl
===================================================================
RCS file: z3950/search.pl
diff -N z3950/search.pl
--- z3950/search.pl 26 Feb 2007 13:34:22 -0000 1.8
+++ /dev/null 1 Jan 1970 00:00:00 -0000
@@ -1,219 +0,0 @@
-#!/usr/bin/perl
-# This is a completely new Z3950 clients search using async ZOOM -TG 02/11/06
-# 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::Output;
-use C4::Interface::CGI::Output;
-use C4::Biblio;
-use C4::Context;
-use C4::Breeding;
-use C4::Koha;
-use ZOOM;
-
-my $input = new CGI;
-my $dbh = C4::Context->dbh;
-my $error = $input->param('error');
-my $biblionumber=$input->param('oldbiblionumber');
-$biblionumber=0 unless $biblionumber;
-my $frameworkcode=$input->param('frameworkcode');
-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 = ();
-
-my $DEBUG = 0; # if set to 1, many debug message are send on syslog.
-
-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,
- });
-
-$template->param(
- intranetcolorstylesheet => C4::Context->preference("intranetcolorstylesheet"),
- intranetstylesheet => C4::Context->preference("intranetstylesheet"),
- IntranetNav => C4::Context->preference("IntranetNav"),
- frameworkcode => $frameworkcode,
- );
-
-if ($op ne "do_search"){
- my $sth=$dbh->prepare("select id,host,checked from z3950servers order by host");
- $sth->execute();
- while ($server=$sth->fetchrow_hashref) {
- my %temploop;
- $temploop{server}=$server->{host};
- $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 => $biblionumber,
- );
- 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';
-# warn "isbn : $isbn";
- $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\"";
- warn "query ".$query if $DEBUG;
- foreach my $servid (@id){
- my $sth=$dbh->prepare("select * from z3950servers where id=?");
- $sth->execute($servid);
- while ($server=$sth->fetchrow_hashref) {
- my $noconnection=0;
- my $option1=new ZOOM::Options();
- $option1->option('async'=>1);
- $option1->option('elementSetName', 'F');
- $option1->option('databaseName',$server->{db}) ;
- $option1->option('user',$server->{userid}) if $server->{userid};
- $option1->option('password',$server->{password}) if $server->{password};
- $option1->option('preferredRecordSyntax', $server->{syntax});
- $oConnection[$s]=create ZOOM::Connection($option1) || $DEBUG && warn ("something went wrong: ".$oConnection[$s]->errmsg());
- warn ("server data",$server->{name}, $server->{port}) if $DEBUG;
- $oConnection[$s]->connect($server->{host}, $server->{port}) || $DEBUG && warn ("something went wrong: ".$oConnection[$s]->errmsg());
- $serverhost[$s]=$server->{host};
- $encoding[$s]=$server->{syntax};
- $s++;
- }## while fetch
- }# foreach
- my $nremaining = $s;
- my $firstresult=1;
-
- for (my $z=0 ;$z<$s;$z++){
- warn "doing the search" if $DEBUG;
- $oResult[$z] = $oConnection[$z]->search_pqf($query) || $DEBUG && warn ("somthing went wrong: " . $oConnection[$s]->errmsg());
-#$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") if $DEBUG;
- last if $event == ZOOM::Event::ZEND;
- }
-
- if ($k != 0) {
- $k--;
- warn $serverhost[$k] if $DEBUG;
- my($error, $errmsg, $addinfo, $diagset) = $oConnection[$k]->error_x();
- if ($error) {
- warn "$k $serverhost[$k] error $query: $errmsg ($error) $addinfo\n" if $DEBUG;
- goto MAYBE_AGAIN;
- }
- my $numresults=$oResult[$k]->size() ;
- my $i;
- my $result='';
- 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::Record->new_from_usmarc($marcdata);#rec->raw();
- #$marcrecord= FixEncoding($marcdata);
-####WARNING records coming from Z3950 clients are in various character sets MARC8,UTF8,UNIMARC etc
-## In HEAD i change everything to UTF-8
-# In rel2_2 i am not sure what encoding is so no character conversion is done here
-##Add necessary encoding changes to here -TG
- my $oldbiblio = MARCmarc2koha($dbh,$marcrecord,"");
- $oldbiblio->{isbn} =~ s/ |-|\.//g,
- $oldbiblio->{issn} =~ s/ |-|\.//g,
- my ($notmarcrecord,$alreadyindb,$alreadyinfarm,$imported,$breedingid)=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} = $breedingid;
- $row_data{oldbiblionumber}=$biblionumber;
- 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, $cookie, $template->output if $numberpending==0;
-
-# print $template->output if $firstresult !=1;
- $firstresult++;
-
- MAYBE_AGAIN:
- if (--$nremaining > 0) {
- goto AGAIN;
- }
-} ## if op=search
Index: z3950/zebraqueue_start.pl
===================================================================
RCS file: z3950/zebraqueue_start.pl
diff -N z3950/zebraqueue_start.pl
--- z3950/zebraqueue_start.pl 6 Sep 2006 16:21:04 -0000 1.1
+++ /dev/null 1 Jan 1970 00:00:00 -0000
@@ -1,57 +0,0 @@
-#!/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;
-use utf8;
-### ZEBRA SERVER UPDATER
-##Uses its own database handle
-my $dbh=C4::Context->dbh;
-my $readsth=$dbh->prepare("select id,biblio_auth_number,operation,server from zebraqueue");
-my $delsth=$dbh->prepare("delete from zebraqueue where id =?");
-
-
-AGAIN:
-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 ($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);
-};
- ## If a delete operation delete the SQL DB as well
- if ($operation eq "recordDelete" && $ok==1){
- if ($server eq "biblioserver"){
- ZEBRAdelbiblio($dbh,$biblionumber);
- }elsif ($server eq "authorityserver"){
- ZEBRAdelauthority($dbh,$biblionumber);
- }
- }
-$delsth->execute($id) if ($ok==1);
-}
-
-sleep $wait;
-goto AGAIN;
\ No newline at end of file
Index: z3950/zebraqueue_windows_start.pl
===================================================================
RCS file: z3950/zebraqueue_windows_start.pl
diff -N z3950/zebraqueue_windows_start.pl
--- z3950/zebraqueue_windows_start.pl 6 Sep 2006 16:21:04 -0000 1.1
+++ /dev/null 1 Jan 1970 00:00:00 -0000
@@ -1,16 +0,0 @@
-#!/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 $fileplace=C4::Context->config('intranetdir');
-my $fullpath=$fileplace."/cgi-bin/z3950";
-my $ZebraObj;
- my $pid=Win32::Process::Create($ZebraObj, "C:/usr/bin/perl.exe",'perl zebraqueue_start.pl', 0, DETACHED_PROCESS,$fullpath) ;
-
-print $input->redirect("/cgi-bin/koha/mainpage.pl?pid=$pid");
More information about the Koha-cvs
mailing list