[Koha-cvs] koha/C4 Context.pm Biblio.pm [dev_week]
Joshua Ferraro
jmf at kados.org
Sun Sep 24 17:24:06 CEST 2006
CVSROOT: /sources/koha
Module name: koha
Branch: dev_week
Changes by: Joshua Ferraro <kados> 06/09/24 15:24:06
Modified files:
C4 : Context.pm Biblio.pm
Log message:
remove Zebraauth routine, fold the functionality into Zconn
Zconn can now take several arguments ... this will probably
change soon as I'm not completely happy with the readability
of the current format ... see the POD for details.
cleaning up Biblio.pm, removing unnecessary routines.
DeleteBiblio - used to delete a biblio from zebra and koha tables
-- checks to make sure there are no existing issues
-- saves backups of biblio,biblioitems,items in deleted* tables
-- does commit operation
getRecord - used to retrieve one record from zebra in piggyback mode using biblionumber
brought back z3950_extended_services routine
Lots of modifications to Context.pm, you can now store user and pass info for
multiple servers (for federated searching) using the <serverinfo> element.
I'll commit my koha.xml to demonstrate this or you can refer to the POD in
Context.pm (which I also expanded on).
CVSWeb URLs:
http://cvs.savannah.gnu.org/viewcvs/koha/C4/Context.pm?cvsroot=koha&only_with_tag=dev_week&r1=1.18.2.5.2.13&r2=1.18.2.5.2.14
http://cvs.savannah.gnu.org/viewcvs/koha/C4/Biblio.pm?cvsroot=koha&only_with_tag=dev_week&r1=1.115.2.51.2.17&r2=1.115.2.51.2.18
Patches:
Index: Context.pm
===================================================================
RCS file: /sources/koha/koha/C4/Context.pm,v
retrieving revision 1.18.2.5.2.13
retrieving revision 1.18.2.5.2.14
diff -u -b -r1.18.2.5.2.13 -r1.18.2.5.2.14
--- Context.pm 10 Aug 2006 02:10:21 -0000 1.18.2.5.2.13
+++ Context.pm 24 Sep 2006 15:24:06 -0000 1.18.2.5.2.14
@@ -1,3 +1,4 @@
+package C4::Context;
# Copyright 2002 Katipo Communications
#
# This file is part of Koha.
@@ -15,17 +16,19 @@
# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
# Suite 330, Boston, MA 02111-1307 USA
-# $Id: Context.pm,v 1.18.2.5.2.13 2006/08/10 02:10:21 kados Exp $
-package C4::Context;
+# $Id: Context.pm,v 1.18.2.5.2.14 2006/09/24 15:24:06 kados Exp $
use strict;
use DBI;
-use C4::Boolean;
+use ZOOM;
use XML::Simple;
+
+use C4::Boolean;
+
use vars qw($VERSION $AUTOLOAD),
qw($context),
qw(@context_stack);
-$VERSION = do { my @v = '$Revision: 1.18.2.5.2.13 $' =~ /\d+/g;
+$VERSION = do { my @v = '$Revision: 1.18.2.5.2.14 $' =~ /\d+/g;
shift(@v) . "." . join("_", map {sprintf "%03d", $_ } @v); };
=head1 NAME
@@ -39,7 +42,13 @@
use C4::Context("/path/to/koha.xml");
$config_value = C4::Context->config("config_variable");
+
+ $koha_preference = C4::Context->preference("preference");
+
$db_handle = C4::Context->dbh;
+
+ $Zconn = C4::Context->Zconn;
+
$stopwordhash = C4::Context->stopwords;
=head1 DESCRIPTION
@@ -97,38 +106,46 @@
$context = undef; # Initially, no context is set
@context_stack = (); # Initially, no saved contexts
-# read_config_file
-# Reads the specified Koha config file. Returns a reference-to-hash
-# whose keys are the configuration variables, and whose values are the
-# configuration values (duh).
-# Returns undef in case of error.
-#
-# Revision History:
-# 2004-08-10 A. Tarallo: Added code that checks if a variable is already
-# assigned and prints a message, otherwise create a new entry in the hash to
-# be returned.
-# Also added code that complaints if finds a line that isn't a variable
-# assignmet and skips the line.
-# Added a quick hack that makes the translation between the db_schema
-# and the DBI driver for that schema.
-#
-sub read_config_file
-{
- my $fname = shift; # Config file to read
+=item read_config_file
- my $retval = {}; # Return value: ref-to-hash holding the
- # configuration
+=over 4
-my $koha = XMLin($fname, keyattr => ['id'],forcearray => ['listen']);
+Reads the specified Koha config file.
+Returns an object containing the configuration variables. The object's
+structure is a bit complex to the uninitiated ... take a look at the
+koha.xml file as well as the XML::Simple documentation for details. Or,
+here are a few examples that may give you what you need:
+
+The simple elements nested within the <config> element:
+
+ my $pass = $koha->{'config'}->{'pass'};
+
+The <listen> elements:
+
+ my $listen = $koha->{'listen'}->{'biblioserver'}->{'content'};
+
+The elements nested within the <server> element:
+
+ my $ccl2rpn = $koha->{'server'}->{'biblioserver'}->{'cql2rpn'};
+
+Returns undef in case of error.
+
+=back
+
+=cut
+
+sub read_config_file {
+ my $fname = shift; # Config file to read
+ my $retval = {}; # Return value: ref-to-hash holding the configuration
+ my $koha = XMLin($fname, keyattr => ['id'],forcearray => ['listen']);
return $koha;
}
# db_scheme2dbi
# Translates the full text name of a database into de appropiate dbi name
#
-sub db_scheme2dbi
-{
+sub db_scheme2dbi {
my $name = shift;
for ($name) {
@@ -140,8 +157,7 @@
return undef; # Just in case
}
-sub import
-{
+sub import {
my $package = shift;
my $conf_fname = shift; # Config file name
my $context;
@@ -170,8 +186,7 @@
#'
# Revision History:
# 2004-08-10 A. Tarallo: Added check if the conf file is not empty
-sub new
-{
+sub new {
my $class = shift;
my $conf_fname = shift; # Config file to load
my $self = {};
@@ -190,14 +205,11 @@
$self = read_config_file($conf_fname);
$self->{"config_file"} = $conf_fname;
-
-
warn "read_config_file($conf_fname) returned undef" if !defined($self->{"config"});
return undef if !defined($self->{"config"});
$self->{"dbh"} = undef; # Database handle
$self->{"Zconn"} = undef; # Zebra Connection
- $self->{"Zconnauth"} = undef; # Zebra Connection for updating
$self->{"stopwords"} = undef; # stopwords list
$self->{"marcfromkohafield"} = undef; # the hash with relations between koha table fields and MARC field/subfield
$self->{"userenv"} = undef; # User env
@@ -386,97 +398,112 @@
=item Zconn
$Zconn = C4::Context->Zconn
-$Zconnauth = C4::Context->Zconnauth
+
Returns a connection to the Zebra database for the current
context. If no connection has yet been made, this method
creates one and connects.
+C<$self>
+
+C<$server> one of the servers defined in the koha.xml file
+
+C<$async> whether this is a asynchronous connection
+
+C<$auth> whether this connection has rw access (1) or just r access (0 or NULL)
+
+
=cut
sub Zconn {
- my $self = shift;
+ my $self=shift;
my $server=shift;
- my $Zconn;
- if (defined($context->{"Zconn"})) {
- $Zconn = $context->{"Zconn"};
+ my $async=shift;
+ my $auth=shift;
+ my $piggyback=shift;
+ my $syntax=shift;
+
+ if ( defined($context->{"Zconn"}) ) {
return $context->{"Zconn"};
+
+ # No connection object or it died. Create one.
} else {
- $context->{"Zconn"} = &new_Zconn($server);
+ $context->{"Zconn"} = &_new_Zconn($server,$async,$auth,$piggyback,$syntax);
return $context->{"Zconn"};
}
}
-sub Zconnauth {
- my $self = shift;
- my $server="biblioserver"; #shift;
- my $Zconnauth;
-##We destroy each connection made so create a new one
- $context->{"Zconnauth"} = &new_Zconnauth($server);
- return $context->{"Zconnauth"};
-}
+=item _new_Zconn
+
+$context->{"Zconn"} = &_new_Zconn($server,$async);
+Internal function. Creates a new database connection from the data given in the current context and returns it.
+C<$server> one of the servers defined in the koha.xml file
-=item new_Zconn
+C<$async> whether this is a asynchronous connection
-Internal helper function. creates a new database connection from
-the data given in the current context and returns it.
+C<$auth> whether this connection has rw access (1) or just r access (0 or NULL)
=cut
-sub new_Zconn {
-use ZOOM;
-my $server=shift;
-my $tried=0;
-my $Zconn;
-my ($tcp,$host,$port)=split /:/,$context->{"listen"}->{$server}->{"content"};
-retry:
+sub _new_Zconn {
+ my ($server,$async,$auth,$piggyback,$syntax) = @_;
+
+ my $tried=0; # first attempt
+ my $Zconn; # connection object
+ $server = "biblioserver" unless $server;
+ $syntax = "usmarc" unless $syntax;
+
+ my $host = $context->{'listen'}->{$server}->{'content'};
+ my $user = $context->{"serverinfo"}->{$server}->{"user"};
+ my $password = $context->{"serverinfo"}->{$server}->{"password"};
+
+ retry:
eval {
- $Zconn=new ZOOM::Connection($context->config("hostname"),$port,databaseName=>$context->{"config"}->{$server},
- preferredRecordSyntax => "USmarc",elementSetName=> "F");
+ # set options
+ my $o = new ZOOM::Options();
+ $o->option(async => 1) if $async;
+ $o->option(count => $piggyback) if $piggyback;
+ $o->option(cqlfile=> $context->{"server"}->{$server}->{"cql2rpn"});
+ $o->option(cclfile=> $context->{"serverinfo"}->{$server}->{"ccl2rpn"});
+ $o->option(preferredRecordSyntax => $syntax);
+ $o->option(elementSetName => "F"); # F for 'full' as opposed to B for 'brief'
+ $o->option(user=>$user) if $auth;
+ $o->option(password=>$password) if $auth;
+ $o->option(databaseName => "biblios"); #$context->{"config"}->{$server});
+
+ # create a new connection object
+ $Zconn= create ZOOM::Connection($o);
+
+ # forge to server
+ $Zconn->connect($host, 0);
+
+ # check for errors and warn
+ if ($Zconn->errcode() !=0) {
+ warn "something wrong with the connection: ". $Zconn->errmsg();
+ }
- $Zconn->option(cqlfile=> $context->{"config"}->{"intranetdir"}."/etc/cql.properties");
- $Zconn->option(cclfile=> $context->{"config"}->{"intranetdir"}."/etc/ccl.properties");
};
- if ($@){
-###Uncomment the lines below if you want to automatically restart your zebra if its stop
-###The system call is for Windows it should be changed to unix deamon starting for Unix platforms
- # if ($@->code==10000 && $tried==0){ ##No connection try restarting Zebra
- # $tried==1;
- # my $res=system('sc start "Z39.50 Server" >/koha/log/zebra-error.log');
- # goto "retry";
- # }else{
- # warn "Error ", $@->code(), ": ", $@->message(), "\n";
+ if ($@) {
+ # Koha manages the Zebra server -- this doesn't work currently for me because of permissions issues
+ # Also, I'm skeptical about whether it's the best approach anyway
+ warn "problem with Zebra";
+ if ( C4::Context->preference("ManageZebra") ) {
+ if ($@->code==10000 && $tried==0) { ##No connection try restarting Zebra
+ $tried=1;
+ warn "trying to restart Zebra";
+ my $res=system("zebrasrv -f $ENV{'KOHA_CONF'} >/koha/log/zebra-error.log");
+ goto "retry";
+ } else {
+ warn "Error ", $@->code(), ": ", $@->message(), "\n";
$Zconn="error";
- # return $Zconn;
- # }
+ return $Zconn;
+ }
+ }
}
return $Zconn;
}
-## Zebra handler with write permission
-sub new_Zconnauth {
- use ZOOM;
- my $server=shift;
- my $tried=0;
- my $Zconnauth;
- my ($tcp,$host,$port)=split /:/,$context->{"listen"}->{$server}->{"content"};
- my $o = new ZOOM::Options();
- $o->option(async => 1);
- $o->option(preferredRecordSyntax => "usmarc");
- $o->option(elementSetName => "F");
- $o->option(user=>$context->{"config"}->{"zebrauser"});
- $o->option(password=>$context->{"config"}->{"zebrapass"});
- $o->option(databaseName=>$context->{"config"}->{$server});
-
-retry:
-
- $Zconnauth=create ZOOM::Connection($o);
- $Zconnauth->connect($context->config("hostname"),$port);
- return $Zconnauth;
-}
-
-
# _new_dbh
# Internal helper function (not a method!). This creates a new
# database connection from the data given in the current context, and
@@ -806,14 +833,35 @@
=head1 SEE ALSO
-DBI(3)
-
-=head1 AUTHOR
+=head1 AUTHORS
Andrew Arensburger <arensb at ooblick dot com>
+Joshua Ferraro <jmf at liblime dot com>
+
=cut
# $Log: Context.pm,v $
+# Revision 1.18.2.5.2.14 2006/09/24 15:24:06 kados
+# remove Zebraauth routine, fold the functionality into Zconn
+# Zconn can now take several arguments ... this will probably
+# change soon as I'm not completely happy with the readability
+# of the current format ... see the POD for details.
+#
+# cleaning up Biblio.pm, removing unnecessary routines.
+#
+# DeleteBiblio - used to delete a biblio from zebra and koha tables
+# -- checks to make sure there are no existing issues
+# -- saves backups of biblio,biblioitems,items in deleted* tables
+# -- does commit operation
+#
+# getRecord - used to retrieve one record from zebra in piggyback mode using biblionumber
+# brought back z3950_extended_services routine
+#
+# Lots of modifications to Context.pm, you can now store user and pass info for
+# multiple servers (for federated searching) using the <serverinfo> element.
+# I'll commit my koha.xml to demonstrate this or you can refer to the POD in
+# Context.pm (which I also expanded on).
+#
# Revision 1.18.2.5.2.13 2006/08/10 02:10:21 kados
# Turned warnings on, and running a search turned up lots of warnings.
# Cleaned up those ...
Index: Biblio.pm
===================================================================
RCS file: /sources/koha/koha/C4/Biblio.pm,v
retrieving revision 1.115.2.51.2.17
retrieving revision 1.115.2.51.2.18
diff -u -b -r1.115.2.51.2.17 -r1.115.2.51.2.18
--- Biblio.pm 22 Sep 2006 19:45:46 -0000 1.115.2.51.2.17
+++ Biblio.pm 24 Sep 2006 15:24:06 -0000 1.115.2.51.2.18
@@ -21,6 +21,7 @@
require Exporter;
use C4::Context;
use C4::Database;
+
use MARC::Record;
use MARC::File::USMARC;
use MARC::File::XML;
@@ -32,34 +33,32 @@
@ISA = qw(Exporter);
-#
-# don't forget MARCxxx subs are exported only for testing purposes. Should not be used
-# as the old-style API and the NEW one are the only public functions.
-#
@EXPORT = qw(
&updateBiblio &updateBiblioItem &updateItem
&newbiblio &newbiblioitem
&modnote &newsubject &newsubtitle
- &modbiblio &checkitems
+
+ &checkitems
+
&newitems &modbibitem
&modsubtitle &modsubject &modaddauthor &moditem &countitems
- &delitem &deletebiblioitem &delbiblio
&getbiblio &getstacks
&getbiblioitembybiblionumber
&getbiblioitem &getitemsbybiblioitem
&skip &getitemtypes &get_itypes
-
- &MARCfind_oldbiblionumber_from_MARCbibid
&MARCfind_MARCbibid_from_oldbiblionumber
&MARCfind_marc_from_kohafield
&MARCfindsubfield
&MARCfind_frameworkcode
&MARCgettagslib
&MARCmoditemonefield
+
+ &DeleteBiblio
+
&NEWnewbiblio &NEWnewitem
&NEWmodbiblio &NEWmoditem
- &NEWdelbiblio &NEWdelitem
+ &NEWdelitem
&NEWmodbiblioframework
&zebraop
@@ -73,164 +72,132 @@
&MARCdelsubfield
&MARCgetbiblio2
+
&char_decode
&DisplayISBN
-&itemcalculator &calculatelc
+ &itemcalculator &calculatelc
);
-#
-#
-# MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC
-#
-#
-# all the following subs takes a MARC::Record as parameter and manage
-# the MARC-DB. They are called by the 1.0/1.2 xxx subs, and by the
-# NEWxxx subs (xxx deals with old-DB parameters, the NEWxxx deals with MARC-DB parameter)
-
=head1 NAME
-C4::Biblio - acquisition, catalog management functions
-
-=head1 SYNOPSIS
-
-move from 1.2 to 1.4 version :
-1.2 and previous version uses a specific API to manage biblios. This API uses old-DB style parameters.
-In the 1.4 version, we want to do 2 differents things :
- - keep populating the old-DB, that has a LOT less datas than MARC
- - populate the MARC-DB
-To populate the DBs we have 2 differents sources :
- - the standard acquisition system (through book sellers), that does'nt use MARC data
- - the MARC acquisition system, that uses MARC data.
-
-Thus, we have 2 differents cases :
-- with the standard acquisition system, we have non MARC data and want to populate old-DB and MARC-DB, knowing it's an incomplete MARC-record
-- with the MARC acquisition system, we have MARC datas, and want to loose nothing in MARC-DB. So, we can't store datas in old-DB, then copy in MARC-DB. we MUST have an API for true MARC data, that populate MARC-DB then old-DB
-
-That's why we need 4 subs :
-all I<subs beginning by MARC> manage only MARC tables. They manage MARC-DB with MARC::Record parameters
-all I<subs beginning by OLD> manage only OLD-DB tables. They manage old-DB with old-DB parameters
-all I<subs beginning by NEW> manage both OLD-DB and MARC tables. They use MARC::Record as parameters. it's the API that MUST be used in MARC acquisition system
-all I<subs beginning by seomething else> are the old-style API. They use old-DB as parameter, then call internally the OLD and MARC subs.
-
-- NEW and old-style API should be used in koha to manage biblio
-- MARCsubs are divided in 2 parts :
-* some of them manage MARC parameters. They are heavily used in koha.
-* some of them manage MARC biblio : they are mostly used by NEW and old-style subs.
-- OLD are used internally only
-
-all subs requires/use $dbh as 1st parameter.
-
-I<NEWxxx related subs>
-
-all subs requires/use $dbh as 1st parameter.
-those subs are used by the MARC-compliant version of koha : marc import, or marc management.
-
-I<OLDxxx related subs>
-
-all subs requires/use $dbh as 1st parameter.
-those subs are used by the MARC-compliant version of koha : marc import, or marc management.
-
-They all are the exact copy of 1.0/1.2 version of the sub without the OLD.
-The OLDxxx is called by the original xxx sub.
-the 1.4 xxx sub also builds MARC::Record an calls the MARCxxx
-
-WARNING : there is 1 difference between initialxxx and OLDxxx :
-the db header $dbh is always passed as parameter to avoid over-DB connexion
+C4::Biblio - acquisitions and cataloging management functions
=head1 DESCRIPTION
-=over 4
-
-=item @tagslib = &MARCgettagslib($dbh,1|0,$itemtype);
-
-last param is 1 for liblibrarian and 0 for libopac
-$itemtype contains the itemtype framework reference. If empty or does not exist, the default one is used
-returns a hash with tag/subfield meaning
-=item ($tagfield,$tagsubfield) = &MARCfind_marc_from_kohafield($dbh,$kohafield);
-
-finds MARC tag and subfield for a given kohafield
-kohafield is "table.field" where table= biblio|biblioitems|items, and field a field of the previous table
-
-=item $biblionumber = &MARCfind_oldbiblionumber_from_MARCbibid($dbh,$MARCbibi);
-finds a old-db biblio number for a given MARCbibid number
-=item $bibid = &MARCfind_MARCbibid_from_oldbiblionumber($dbh,$oldbiblionumber);
+=head1 FUNCTIONS
-finds a MARC bibid from a old-db biblionumber
+=head2 z3950_extended_services
-=item $MARCRecord = &MARCkoha2marcBiblio($dbh,$biblionumber,biblioitemnumber);
-
-MARCkoha2marcBiblio is a wrapper between old-DB and MARC-DB. It returns a MARC::Record builded with old-DB biblio/biblioitem
-
-=item $MARCRecord = &MARCkoha2marcItem($dbh,$biblionumber,itemnumber);
+=over 4
-MARCkoha2marcItem is a wrapper between old-DB and MARC-DB. It returns a MARC::Record builded with old-DB item
+z3950_extended_services($serviceType,$serviceOptions,$record);
-=item $MARCRecord = &MARCkoha2marcSubtitle($dbh,$biblionumber,$subtitle);
+ z3950_extended_services is used to handle all interactions with Zebra's extended serices package, which is employed to perform all management of the MARC data stored in Zebra.
-MARCkoha2marcSubtitle is a wrapper between old-DB and MARC-DB. It returns a MARC::Record builded with old-DB subtitle
+C<$serviceType> one of: itemorder,create,drop,commit,update,xmlupdate
-=item $olddb = &MARCmarc2koha($dbh,$MARCRecord);
+C<$serviceOptions> a has of key/value pairs. For instance, if service_type is 'update', $service_options should contain:
-builds a hash with old-db datas from a MARC::Record
+ action => update action, one of specialUpdate, recordInsert, recordReplace, recordDelete, elementUpdate.
-=item &MARCaddbiblio($dbh,$MARC::Record,$biblionumber);
+and maybe
-creates a biblio (in the MARC tables only). $biblionumber is the old-db biblionumber of the biblio
+ recordidOpaque => Opaque Record ID (user supplied) or recordidNumber => Record ID number (system number).
+ syntax => the record syntax (transfer syntax)
+ databaseName = Database from connection object
-=item &MARCaddsubfield($dbh,$bibid,$tagid,$indicator,$tagorder,$subfieldcode,$subfieldorder,$subfieldvalue);
+ To set serviceOptions, call set_service_options($serviceType)
-adds a subfield in a biblio (in the MARC tables only).
+C<$record> the record, if one is needed for the service type
-=item $MARCRecord = &MARCgetbiblio($dbh,$bibid);
+ A record should be in XML. You can convert it to XML from MARC by running it through marc2xml().
-Returns a MARC::Record for the biblio $bibid.
+=back
-=item &MARCmodbiblio($dbh,$bibid,$record,$frameworkcode,$delete);
+=cut
-MARCmodbiblio changes a biblio for a biblio,MARC::Record passed as parameter
-It 1st delete the biblio, then recreates it.
-WARNING : the $delete parameter is not used anymore (too much unsolvable cases).
-=item ($subfieldid,$subfieldvalue) = &MARCmodsubfield($dbh,$subfieldid,$subfieldvalue);
+sub z3950_extended_services {
+ my ($server,$serviceType,$action,$serviceOptions) = @_;
-MARCmodsubfield changes the value of a given subfield
+ # get our connection object
+ my $Zconn = C4::Context->Zconn($server,0,1);
-=item $subfieldid = &MARCfindsubfield($dbh,$bibid,$tag,$subfieldcode,$subfieldorder,$subfieldvalue);
+ # create a new package object
+ my $Zpackage = $Zconn->package();
-MARCfindsubfield returns a subfield number given a bibid/tag/subfieldvalue values.
-Returns -1 if more than 1 answer
+ # set our options
+ $Zpackage->option(action => $action);
-=item $subfieldid = &MARCfindsubfieldid($dbh,$bibid,$tag,$tagorder,$subfield,$subfieldorder);
+ if ($serviceOptions->{'databaseName'}) {
+ $Zpackage->option(databaseName => $serviceOptions->{'databaseName'});
+ }
+ if ($serviceOptions->{'recordIdNumber'}) {
+ $Zpackage->option(recordIdNumber => $serviceOptions->{'recordIdNumber'});
+ }
+ if ($serviceOptions->{'recordIdOpaque'}) {
+ $Zpackage->option(recordIdOpaque => $serviceOptions->{'recordIdOpaque'});
+ }
-MARCfindsubfieldid find a subfieldid for a bibid/tag/tagorder/subfield/subfieldorder
+ # this is an ILL request (Zebra doesn't support it, but Koha could eventually)
+ #if ($serviceType eq 'itemorder') {
+ # $Zpackage->option('contact-name' => $serviceOptions->{'contact-name'});
+ # $Zpackage->option('contact-phone' => $serviceOptions->{'contact-phone'});
+ # $Zpackage->option('contact-email' => $serviceOptions->{'contact-email'});
+ # $Zpackage->option('itemorder-item' => $serviceOptions->{'itemorder-item'});
+ #}
-=item &MARCdelsubfield($dbh,$bibid,$tag,$tagorder,$subfield,$subfieldorder);
+ if ($serviceOptions->{record}) {
+ $Zpackage->option(record => $serviceOptions->{record});
-MARCdelsubfield delete a subfield for a bibid/tag/tagorder/subfield/subfieldorder
-If $subfieldorder is not set, delete all the $tag$subfield subfields
+ # can be xml or marc
+ if ($serviceOptions->{'syntax'}) {
+ $Zpackage->option(syntax => $serviceOptions->{'syntax'});
+ }
+ }
-=item &MARCdelbiblio($dbh,$bibid);
+ # send the request, handle any exception encountered
+ eval { $Zpackage->send($serviceType) };
+ if ($@ && $@->isa("ZOOM::Exception")) {
+ return "error: ".$@->code()." ".$@->message()."\n";
+ }
+ # free up package resources
+ $Zpackage->destroy();
+}
-MARCdelbiblio delete biblio $bibid
+=head2 set_service_options
-=item &MARCkoha2marcOnefield
+=over 4
-used by MARCkoha2marc and should not be useful elsewhere
+my $serviceOptions = set_service_options($serviceType);
-=item &MARCmarc2kohaOnefield
+C<$serviceType> itemorder,create,drop,commit,update,xmlupdate
-used by MARCmarc2koha and should not be useful elsewhere
+Currently, we only support 'create', 'commit', and 'update'. 'drop' support will be added as soon as Zebra supports it.
-=item MARCaddword
+=back
-used to manage MARC_word table and should not be useful elsewhere
+=cut
-=item MARCdelword
+sub set_service_options {
+ my ($serviceType) = @_;
+ my $serviceOptions;
-used to manage MARC_word table and should not be useful elsewhere
+ # FIXME: This needs to be an OID ... if we ever need 'syntax' this sub will need to change
+ # $serviceOptions->{ 'syntax' } = ''; #zebra doesn't support syntaxes other than xml
-=cut
+ if ($serviceType eq 'commit') {
+ # nothing to do
+ }
+ if ($serviceType eq 'create') {
+ # nothing to do
+ }
+ if ($serviceType eq 'drop') {
+ die "ERROR: 'drop' not currently supported (by Zebra)";
+ }
+ return $serviceOptions;
+}
sub MARCgettagslib {
my ( $dbh, $forlibrarian, $frameworkcode ) = @_;
@@ -306,15 +273,6 @@
return ($relations->{$frameworkcode}->{$kohafield}->[0],$relations->{$frameworkcode}->{$kohafield}->[1]);
}
-sub MARCfind_oldbiblionumber_from_MARCbibid {
- my ( $dbh, $MARCbibid ) = @_;
-# my $sth =
- # $dbh->prepare("select biblionumber from marc_biblio where bibid=?");
-# $sth->execute($MARCbibid);
- # my ($biblionumber) = $sth->fetchrow;
- return $MARCbibid;
-}
-
sub MARCfind_MARCbibid_from_oldbiblionumber {
my ( $dbh, $oldbiblionumber ) = @_;
# my $sth =
@@ -325,21 +283,15 @@
}
sub MARCaddbiblio {
-
-# pass the MARC::Record to this function, and it will create the records in the marc tables
+ # pass the MARC::Record to this function, and it will create the records in the marc tables
my ($dbh,$record,$biblionumber,$frameworkcode,$bibid) = @_;
my @fields=$record->fields();
-if (!$frameworkcode){
-$frameworkcode="";
-}
-
- my $sth =
- $dbh->prepare("update biblio set frameworkcode=? where biblionumber=?" );
+ if (!$frameworkcode){
+ $frameworkcode="";
+ }
+ my $sth = $dbh->prepare("update biblio set frameworkcode=? where biblionumber=?" );
$sth->execute( $frameworkcode,$biblionumber );
-
$sth->finish;
-
-
my $encoding = C4::Context->preference("marcflavour");
$sth =$dbh->prepare("update biblioitems set marc=? where biblionumber=?" );
$sth->execute( $record->as_usmarc() , $biblionumber);
@@ -369,33 +321,22 @@
}
sub MARCgetbiblio {
-
# Returns MARC::Record of the biblio passed in parameter.
my ( $dbh, $bibid ) = @_;
-
-
- my $sth =
- $dbh->prepare("select marc from biblioitems where biblionumber=? " );
-
+ my $sth=$dbh->prepare("select marc from biblioitems where biblionumber=? " );
$sth->execute($bibid);
my ($marc)=$sth->fetchrow;
my $record = MARC::File::USMARC::decode($marc);
-
return $record;
-
}
-sub XMLgetbiblio {
+sub XMLgetbiblio {
# Returns MARC::XML of the biblio passed in parameter.
my ( $dbh, $biblionumber ) = @_;
-
-
- my $sth =
- $dbh->prepare("select marc from biblioitems where biblionumber=? " );
-
+ my $sth = $dbh->prepare("select marc from biblioitems where biblionumber=? " );
$sth->execute($biblionumber);
my ($marc)=$sth->fetchrow;
-$marc=MARC::File::USMARC::decode($marc);
+ $marc=MARC::File::USMARC::decode($marc);
my $marcxml=$marc->as_xml_record();
return $marcxml;
@@ -472,21 +413,25 @@
}
return $newrecord;
}
+
sub MARCmodbiblio {
my ($dbh,$bibid,$record,$frameworkcode,$delete)=@_;
-#delete original marcrecord
+
+ # delete original marcrecord
my $newrec=&MARCdelbiblio($dbh,$bibid,$delete);
-# 2nd recreate it
+ # recreate it and add the new fields
my @fields = $record->fields();
-
foreach my $field (@fields) {
-
$newrec->append_fields($field);
}
-##correct the leader
+
+ # correct the leader
$newrec->leader($record->leader());
+
&MARCmodLCindex($dbh,$newrec,$frameworkcode);
+
+ # add it back
&MARCaddbiblio($dbh,$newrec,$bibid,$frameworkcode,$bibid);
}
@@ -497,31 +442,21 @@
# This flag is set when the delbiblio is called by modbiblio
# due to a too complex structure of MARC (repeatable fields and subfields),
# the best solution for a modif is to delete / recreate the record.
-
-# 1st of all, copy the MARC::Record to deletedbiblio table => if a true deletion, MARC data will be kept.
-# if deletion called before MARCmodbiblio => won't do anything, as the oldbiblionumber doesn't
+ # 1st of all, copy the MARC::Record to deletedbiblio table => if a true deletion, MARC data will be kept.
+ # if deletion called before MARCmodbiblio => won't do anything, as the oldbiblionumber doesn't
# exist in deletedbiblio table
my $record = MARCgetbiblio( $dbh, $bibid );
- my $oldbiblionumber =
- MARCfind_oldbiblionumber_from_MARCbibid( $dbh, $bibid );
- my $copy2deleted =
- $dbh->prepare("update deletedbiblio set marc=? where biblionumber=?");
+ my $oldbiblionumber = $bibid;
+ my $copy2deleted = $dbh->prepare("update deletedbiblio set marc=? where biblionumber=?");
$copy2deleted->execute( $record->as_usmarc(), $oldbiblionumber );
my @fields = $record->fields();
# now, delete in MARC tables.
if ( $keep_items eq 1 ) {
-
#search item field code
- my $sth =
- $dbh->prepare(
-"select tagfield from marc_subfield_structure where kohafield like 'items.%'"
- );
+ my $sth = $dbh->prepare("select tagfield from marc_subfield_structure where kohafield like 'items.%'");
$sth->execute;
my $itemtag = $sth->fetchrow_hashref->{tagfield};
-
-
foreach my $field (@fields) {
-
if ($field->tag() ne $itemtag){
$record->delete_field($field);
}#if
@@ -529,9 +464,7 @@
}
else {
foreach my $field (@fields) {
-
$record->delete_field($field);
-
}#foreach
}
return $record;
@@ -569,8 +502,6 @@
return $record;
}
-
-
sub MARCmoditemonefield{
my ($dbh,$biblionumber,$itemnumber,$itemfield,$newvalue)=@_;
if (!defined $newvalue){
@@ -602,9 +533,10 @@
}
}
+
sub MARCmoditem {
my ($dbh,$record,$bibid,$itemnumber,$delete)=@_;
- my $biblionumber = MARCfind_oldbiblionumber_from_MARCbibid($dbh,$bibid);
+ my $biblionumber = $bibid;
my $newrec=&MARCdelitem($dbh,$bibid,$itemnumber);
# 2nd recreate it
@@ -623,6 +555,7 @@
&MARCaddbiblio($dbh,$newrec,$biblionumber);
}
+
sub MARCmodsubfield {
# Subroutine changes a subfield value given a subfieldid.
@@ -923,6 +856,7 @@
return $record;
}
+
sub MARChtml2xml {
my ($tags,$subfields,$values,$indicator,$ind_tag) = @_;
#use MARC::File::XML;
@@ -991,6 +925,7 @@
#warn $xml;
return $xml;
}
+
sub MARChtml2marc {
my ($dbh,$rtags,$rsubfields,$rvalues,%indicators) = @_;
my $prevtag = -1;
@@ -1171,26 +1106,6 @@
$sth->execute( $bibid, $tag, $subfield, $tagorder, $subfieldorder );
}
-#
-#
-# NEW NEW NEW NEW NEW NEW NEW NEW NEW NEW NEW NEW NEW NEW NEW NEW NEW NEW
-#
-#
-# all the following subs are useful to manage MARC-DB with complete MARC records.
-# it's used with marcimport, and marc management tools
-#
-
-=item ($bibid,$oldbibnum,$oldbibitemnum) = NEWnewbibilio($dbh,$MARCRecord,$oldbiblio,$oldbiblioitem);
-
-creates a new biblio from a MARC::Record. The 3rd and 4th parameter are hashes and may be ignored. If only 2 params are passed to the sub, the old-db hashes
-are builded from the MARC::Record. If they are passed, they are used.
-
-=item NEWnewitem($dbh, $record,$bibid);
-
-adds an item in the db.
-
-=cut
-
sub NEWnewbiblio {
my ( $dbh, $record, $frameworkcode) = @_;
my $oldbibnum;
@@ -1384,22 +1299,68 @@
return 1;
}
-sub NEWdelbiblio {
- my ( $dbh, $bibid ) = @_;
- my $biblio = &MARCfind_oldbiblionumber_from_MARCbibid( $dbh, $bibid );
+=item DeleteBiblio
-&zebraop($dbh,$bibid,"RecordDelete","biblioserver");
- &OLDdelbiblio( $dbh, $biblio );
- my $sth =
- $dbh->prepare(
- "select biblioitemnumber from biblioitems where biblionumber=?");
- $sth->execute($biblio);
- while ( my ($biblioitemnumber) = $sth->fetchrow ) {
- OLDdeletebiblioitem( $dbh, $biblioitemnumber );
+Delete complete biblio record from Zebra and Koha tables (biblio,biblioitems,items)
+
+=cut
+
+sub DeleteBiblio {
+ my ( $dbh, $biblionumber ) = @_;
+ my $error; # for error handling
+
+ # First make sure there are no items with issues are still attached
+ my $sth = $dbh->prepare("SELECT biblioitemnumber FROM biblioitems WHERE biblionumber=?");
+ $sth->execute($biblionumber);
+ while ( my $biblioitemnumber = $sth->fetchrow ) {
+ my @issues = C4::Search::itemissues($biblioitemnumber);
+ foreach my $issue (@issues) {
+ if ( ($issue->{date_due}) && ($issue->{date_due} ne "Available") ) {
+ #FIXME: we need a status system in Biblio like in Circ to return standard codes and messages
+ # instead of hard-coded strings
+ $error.="Item is checked out to a patron -- you must return it before deleting the Biblio";
+ }
+ }
}
+ return $error if $error;
+
+ # Delete from Zebra
+ # get the xml of the record from Zebra
+ my $xmlrecord = getRecord("biblioserver","Local-number=$biblionumber");
+ my $serviceOptions;
+ $serviceOptions->{'databaseName'} = "biblios";
+ $serviceOptions->{'record'} = $xmlrecord;
+ $error = &z3950_extended_services("biblioserver","update","recordDelete",$serviceOptions);
+ return $error if $error;
+
+ # run commit operation
+ #if ( (C4::Context->preference("commitImmediately")) ) {
+ $error = &z3950_extended_services("biblioserver","commit");
+ #}
+ #zebraop($dbh,$biblionumber,"recordDelete","biblioserver");
+ return $error if $error;
+
+ # delete biblio from Koha tables and save in deletedbiblio
+ $error = &_KohaDeleteBiblio( $dbh, $biblionumber );
+ return $error if $error;
- &MARCdelbiblio( $dbh, $bibid, 0 );
+ # delete biblioitems and items from Koha tables and save in deletedbiblioitems,deleteditems
+ my $sth = $dbh->prepare("SELECT biblioitemnumber FROM biblioitems WHERE biblionumber=?");
+ $sth->execute($biblionumber);
+ while ( my $biblioitemnumber = $sth->fetchrow ) {
+ # delete this biblioitem
+ $error = &_KohaDeleteBiblioitems( $dbh, $biblioitemnumber );
+ return $error if $error;
+
+ # delete items
+ my $items_sth = $dbh->prepare("SELECT itemnumber FROM items WHERE biblioitemnumber=?");
+ $items_sth->execute($biblioitemnumber);
+ while ( my $itemnumber = $items_sth->fetchrow ) {
+ $error = &_KohaDeleteItems( $dbh, $itemnumber );
+ return $error if $error;
+ }
+ }
}
sub NEWnewitem {
@@ -1408,7 +1369,7 @@
my $frameworkcode=MARCfind_frameworkcode($dbh,$bibid);
my $item = &MARCmarc2koha( $dbh, $record,$frameworkcode );
# needs old biblionumber and biblioitemnumber
- $item->{'biblionumber'} =MARCfind_oldbiblionumber_from_MARCbibid( $dbh, $bibid );
+ $item->{'biblionumber'} = $bibid;
my $sth =
$dbh->prepare(
"select biblioitemnumber,itemtype from biblioitems where biblionumber=?");
@@ -1479,7 +1440,7 @@
sub NEWdelitem {
my ( $dbh, $bibid, $itemnumber ) = @_;
- my $biblio = &MARCfind_oldbiblionumber_from_MARCbibid( $dbh, $bibid );
+ my $biblio = $bibid;
&OLDdelitem( $dbh, $itemnumber );
my $newrec=&MARCdelitem( $dbh, $bibid, $itemnumber );
&MARCaddbiblio($dbh,$newrec,$bibid,);
@@ -1606,7 +1567,7 @@
$sth->finish;
return ( $biblio->{'biblionumber'} );
-} # sub modbiblio
+}
sub OLDmodsubtitle {
my ( $dbh, $bibnum, $subtitle ) = @_;
@@ -2067,31 +2028,139 @@
$sth->finish();
# $dbh->disconnect;
-} # sub deletebiblioitem
+}
+
+=item _KohaDeleteBiblio
+
+$error = _KohaDeleteBiblio($dbh,$biblionumber);
+
+Internal sub for deleting from biblio table -- also saves to deletedbiblio
+
+C<$dbh> - the database handle
+C<$biblionumber> - the biblionumber of the biblio to be deleted
+
+=cut
+# FIXME: add error handling
+
+sub _KohaDeleteBiblio {
+ my ( $dbh, $biblionumber ) = @_;
+
+ # get all the data for this biblio
+ my $sth = $dbh->prepare("SELECT * FROM biblio WHERE biblionumber=?");
+ $sth->execute($biblionumber);
-sub OLDdelbiblio {
- my ( $dbh, $biblio ) = @_;
- my $sth = $dbh->prepare("select * from biblio where biblionumber=?");
- $sth->execute($biblio);
if ( my $data = $sth->fetchrow_hashref ) {
- $sth->finish;
- my $query = "Insert into deletedbiblio set ";
+ # save the record in deletedbiblio
+ # find the fields to save
+ my $query = "INSERT INTO deletedbiblio SET ";
my @bind = ();
foreach my $temp ( keys %$data ) {
$query .= "$temp = ?,";
push ( @bind, $data->{$temp} );
}
- #replacing the last , by ",?)"
+ # replace the last , by ",?)"
$query =~ s/\,$//;
- $sth = $dbh->prepare($query);
- $sth->execute(@bind);
+ my $bkup_sth = $dbh->prepare($query);
+ $bkup_sth->execute(@bind);
+ $bkup_sth->finish;
+
+ # delete the biblio
+ my $del_sth = $dbh->prepare("DELETE FROM biblio WHERE biblionumber=?");
+ $del_sth->execute($biblionumber);
+ $del_sth->finish;
+ }
$sth->finish;
- $sth = $dbh->prepare("Delete from biblio where biblionumber=?");
- $sth->execute($biblio);
+ return undef;
+}
+
+=item _KohaDeleteBiblioitems
+
+$error = _KohaDeleteBiblioitems($dbh,$biblioitemnumber);
+
+Internal sub for deleting from biblioitems table -- also saves to deletedbiblioitems
+
+C<$dbh> - the database handle
+C<$biblionumber> - the biblioitemnumber of the biblioitem to be deleted
+
+=cut
+# FIXME: add error handling
+
+sub _KohaDeleteBiblioitems {
+ my ( $dbh, $biblioitemnumber ) = @_;
+
+ # get all the data for this biblioitem
+ my $sth = $dbh->prepare("SELECT * FROM biblioitems WHERE biblioitemnumber=?");
+ $sth->execute($biblioitemnumber);
+
+ if ( my $data = $sth->fetchrow_hashref ) {
+ # save the record in deletedbiblioitems
+ # find the fields to save
+ my $query = "INSERT INTO deletedbiblioitems SET ";
+ my @bind = ();
+ foreach my $temp ( keys %$data ) {
+ $query .= "$temp = ?,";
+ push ( @bind, $data->{$temp} );
+ }
+
+ # replace the last , by ",?)"
+ $query =~ s/\,$//;
+ my $bkup_sth = $dbh->prepare($query);
+ $bkup_sth->execute(@bind);
+ $bkup_sth->finish;
+
+ # delete the biblioitem
+ my $del_sth = $dbh->prepare("DELETE FROM biblioitems WHERE biblioitemnumber=?");
+ $del_sth->execute($biblioitemnumber);
+ $del_sth->finish;
+ }
$sth->finish;
+ return undef;
+}
+
+
+=item _KohaDeleteItems
+
+$error = _KohaDeleteItems($dbh,$itemnumber);
+
+Internal sub for deleting from items table -- also saves to deleteditems
+
+C<$dbh> - the database handle
+C<$itemnumber> - the itemnumber of the item to be deleted
+
+=cut
+# FIXME: add error handling
+
+sub _KohaDeleteItems {
+ my ( $dbh, $itemnumber ) = @_;
+
+ # get all the data for this item
+ my $sth = $dbh->prepare("SELECT * FROM items WHERE itemnumber=?");
+ $sth->execute($itemnumber);
+
+ if ( my $data = $sth->fetchrow_hashref ) {
+ # save the record in deleteditems
+ # find the fields to save
+ my $query = "INSERT INTO deleteditems SET ";
+ my @bind = ();
+ foreach my $temp ( keys %$data ) {
+ $query .= "$temp = ?,";
+ push ( @bind, $data->{$temp} );
+ }
+
+ # replace the last , by ",?)"
+ $query =~ s/\,$//;
+ my $bkup_sth = $dbh->prepare($query);
+ $bkup_sth->execute(@bind);
+ $bkup_sth->finish;
+
+ # delete the item
+ my $del_sth = $dbh->prepare("DELETE FROM items WHERE itemnumber=?");
+ $del_sth->execute($itemnumber);
+ $del_sth->finish;
}
$sth->finish;
+ return undef;
}
#
@@ -2123,35 +2192,6 @@
return ($bibnum);
}
-=item modbiblio
-
- $biblionumber = &modbiblio($biblio);
-
-Update a biblio record.
-
-C<$biblio> is a reference-to-hash whose keys are the fields in the
-biblio table in the Koha database. All fields must be present, not
-just the ones you wish to change.
-
-C<&modbiblio> updates the record defined by
-C<$biblio-E<gt>{biblionumber}> with the values in C<$biblio>.
-
-C<&modbiblio> returns C<$biblio-E<gt>{biblionumber}> whether it was
-successful or not.
-
-=cut
-
-sub modbiblio {
- my ($biblio) = @_;
- my $dbh = C4::Context->dbh;
- my $biblionumber=OLDmodbiblio($dbh,$biblio);
- my $record = MARCkoha2marcBiblio($dbh,$biblionumber,$biblionumber);
- # finds new (MARC bibid
- my $bibid = &MARCfind_MARCbibid_from_oldbiblionumber($dbh,$biblionumber);
- MARCmodbiblio($dbh,$bibid,$record,"",0);
- return($biblionumber);
-} # sub modbiblio
-
=item modsubtitle
&modsubtitle($biblionumber, $subtitle);
@@ -2305,26 +2345,6 @@
return ( $data->{'count(*)'} );
}
-sub delitem {
- my ($itemnum) = @_;
- my $dbh = C4::Context->dbh;
- &OLDdelitem( $dbh, $itemnum );
-}
-
-sub deletebiblioitem {
- my ($biblioitemnumber) = @_;
- my $dbh = C4::Context->dbh;
- &OLDdeletebiblioitem( $dbh, $biblioitemnumber );
-} # sub deletebiblioitem
-
-sub delbiblio {
- my ($biblio) = @_;
- my $dbh = C4::Context->dbh;
- &OLDdelbiblio( $dbh, $biblio );
- my $bibid = &MARCfind_MARCbibid_from_oldbiblionumber( $dbh, $biblio );
- &MARCdelbiblio( $dbh, $bibid, 0 );
-}
-
sub getbiblio {
my ($biblionumber) = @_;
my $dbh = C4::Context->dbh;
@@ -2770,75 +2790,88 @@
}
sub zebraopfiles{
-my ($dbh,$biblionumber,$record,$folder,$server)=@_;
-#my $record = XMLgetbiblio($dbh,$biblionumber);
-my $op;
-my $zebradir = C4::Context->zebraconfig($server)->{directory}."/".$folder."/";
+ my ($dbh,$biblionumber,$record,$folder,$server)=@_;
+ #my $record = XMLgetbiblio($dbh,$biblionumber);
+ my $op;
+ my $zebradir = C4::Context->zebraconfig($server)->{directory}."/".$folder."/";
unless (opendir(DIR, "$zebradir")) {
warn "$zebradir not found";
return;
}
closedir DIR;
my $filename = $zebradir.$biblionumber;
-if ($record){
+
+ if ($record){
open (OUTPUT,">", $filename.".xml");
print OUTPUT $record;
-
close OUTPUT;
+ }
}
+=item zebraop
+=over 4
-}
+=back
+=cut
-sub zebraop{
-###Accepts a $server variable thus we can use it for biblios authorities or other zebra dbs
+sub zebraop {
+ ###Accepts a $server variable thus we can use it for biblios authorities or other zebra dbs
my ($dbh,$biblionumber,$op,$server)=@_;
#warn "SERVER:".$server;
my @Zconnbiblio;
-my $tried=0;
-my $recon=0;
-my $reconnect=0;
-my $record;
-my $shadow;
-reconnect:
-$Zconnbiblio[0]=C4::Context->Zconnauth($server);
- if ($server eq "biblioserver"){
- $record =XMLgetbiblio($dbh,$biblionumber);
+ my $tried=0;
+ my $recon=0;
+ my $reconnect=0;
+ my $record;
+ my $shadow;
+
+ reconnect:
+ $Zconnbiblio[0]=C4::Context->Zconn($server,0,1);
+
+ if ($server eq "biblioserver") {
+ # it's unclear to me whether this should be in xml or MARC format
+ # but it is clear it should be nabbed from zebra rather than from
+ # the koha tables
+ $record=MARCgetbiblio($dbh,$biblionumber);
+ #warn "RECORD".$record->as_usmarc();
$shadow="biblioservershadow";
- }elsif($server eq "authorityserver"){
+
+ } elsif ($server eq "authorityserver") {
$record =C4::AuthoritiesMarc::XMLgetauthority($dbh,$biblionumber);
$shadow="authorityservershadow";
} ## Add other servers as necessary
-
-my $Zpackage = $Zconnbiblio[0]->package();
-$Zpackage->option(action => $op);
+ my $Zpackage = $Zconnbiblio[0]->package();
+ $Zpackage->option(action => $op);
$Zpackage->option(record => $record);
-retry:
+
+ retry:
$Zpackage->send("update");
-my $i;
-my $event;
+ my $i;
+ my $event;
-while (($i = ZOOM::event(\@Zconnbiblio)) != 0) {
+ while (($i = ZOOM::event(\@Zconnbiblio)) != 0) {
$event = $Zconnbiblio[0]->last_event();
last if $event == ZOOM::Event::ZEND;
-}
+ }
+
my($error, $errmsg, $addinfo, $diagset) = $Zconnbiblio[0]->error_x();
if ($error==10000 && $reconnect==0) { ## This is serious ZEBRA server is not available -reconnect
+ warn "problem with zebra server connection";
$reconnect=1;
my $res=system('sc start "Z39.50 Server" >c:/zebraserver/error.log');
- warn "Trying to restart ZEBRA Server";
- goto "reconnect";
- }elsif ($error==10007 && $tried<2) {## timeout --another 30 looonng seconds for this update
+ #warn "Trying to restart ZEBRA Server";
+ #goto "reconnect";
+ } elsif ($error==10007 && $tried<2) {## timeout --another 30 looonng seconds for this update
$tried=$tried+1;
goto "retry";
- }elsif($error==10004 && $recon==0){##Lost connection -reconnect
+ } elsif($error==10004 && $recon==0) {##Lost connection -reconnect
$recon=1;
goto "reconnect";
- }elsif ($error){
+ } elsif ($error) {
warn "Error-$server $op $biblionumber /errcode:, $error, /MSG:,$errmsg,$addinfo \n";
$Zpackage->destroy();
$Zconnbiblio[0]->destroy();
@@ -2851,9 +2884,8 @@
#waiting zebra to finish;
}
}
-$Zpackage->destroy();
-$Zconnbiblio[0]->destroy();
-
+ $Zpackage->destroy();
+ $Zconnbiblio[0]->destroy();
}
@@ -2921,6 +2953,21 @@
}
+=item getRecord
+
+get a single record in piggyback mode from Zebra and return it in the requested record syntax
+
+default record syntax is XML
+
+=cut
+
+sub getRecord {
+ my ($server,$koha_query,$recordSyntax) = @_;
+ $recordSyntax = "xml" unless $recordSyntax;
+ my $Zconn = C4::Context->Zconn($server,0,1,1,$recordSyntax);
+ my $rs = $Zconn->search(new ZOOM::Query::CCL2RPN($koha_query,$Zconn));
+ return $rs->record(0)->raw();
+}
@@ -2936,8 +2983,29 @@
=cut
-# $Id: Biblio.pm,v 1.115.2.51.2.17 2006/09/22 19:45:46 kados Exp $
+# $Id: Biblio.pm,v 1.115.2.51.2.18 2006/09/24 15:24:06 kados Exp $
# $Log: Biblio.pm,v $
+# Revision 1.115.2.51.2.18 2006/09/24 15:24:06 kados
+# remove Zebraauth routine, fold the functionality into Zconn
+# Zconn can now take several arguments ... this will probably
+# change soon as I'm not completely happy with the readability
+# of the current format ... see the POD for details.
+#
+# cleaning up Biblio.pm, removing unnecessary routines.
+#
+# DeleteBiblio - used to delete a biblio from zebra and koha tables
+# -- checks to make sure there are no existing issues
+# -- saves backups of biblio,biblioitems,items in deleted* tables
+# -- does commit operation
+#
+# getRecord - used to retrieve one record from zebra in piggyback mode using biblionumber
+# brought back z3950_extended_services routine
+#
+# Lots of modifications to Context.pm, you can now store user and pass info for
+# multiple servers (for federated searching) using the <serverinfo> element.
+# I'll commit my koha.xml to demonstrate this or you can refer to the POD in
+# Context.pm (which I also expanded on).
+#
# Revision 1.115.2.51.2.17 2006/09/22 19:45:46 kados
# changing name of auth value
#
More information about the Koha-cvs
mailing list