2191 lines
No EOL
71 KiB
Perl
2191 lines
No EOL
71 KiB
Perl
package C4::Biblio;
|
||
|
||
# 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;
|
||
require Exporter;
|
||
use C4::Context;
|
||
use C4::Database;
|
||
use MARC::Record;
|
||
use MARC::File::USMARC;
|
||
use MARC::File::XML;
|
||
|
||
use vars qw($VERSION @ISA @EXPORT);
|
||
|
||
# set the version for version checking
|
||
$VERSION = 0.01;
|
||
|
||
@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
|
||
&itemcount &newbiblio &newbiblioitem
|
||
&modnote &newsubject &newsubtitle
|
||
&modbiblio &checkitems
|
||
&newitems &modbibitem
|
||
&modsubtitle &modsubject &modaddauthor &moditem &countitems
|
||
&delitem &deletebiblioitem &delbiblio
|
||
&getbiblio
|
||
&getbiblioitembybiblionumber
|
||
&getbiblioitem &getitemsbybiblioitem
|
||
&skip &getitemtypes
|
||
&newcompletebiblioitem
|
||
|
||
&MARCfind_marc_from_kohafield
|
||
&MARCfind_frameworkcode
|
||
&find_biblioitemnumber
|
||
&MARCgettagslib
|
||
|
||
&NEWnewbiblio &NEWnewitem
|
||
&NEWmodbiblio &NEWmoditem
|
||
&NEWdelbiblio &NEWdelitem
|
||
&NEWmodbiblioframework
|
||
|
||
&MARCkoha2marcBiblio &MARCmarc2koha
|
||
&MARCkoha2marcItem &MARChtml2marc
|
||
&MARCgetbiblio &MARCgetitem
|
||
&char_decode
|
||
|
||
&FindDuplicate
|
||
&DisplayISBN
|
||
);
|
||
|
||
#
|
||
#
|
||
# 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
|
||
|
||
=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);
|
||
|
||
finds a MARC bibid from a old-db biblionumber
|
||
|
||
=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);
|
||
|
||
MARCkoha2marcItem is a wrapper between old-DB and MARC-DB. It returns a MARC::Record builded with old-DB item
|
||
|
||
=item $MARCRecord = &MARCkoha2marcSubtitle($dbh,$biblionumber,$subtitle);
|
||
|
||
MARCkoha2marcSubtitle is a wrapper between old-DB and MARC-DB. It returns a MARC::Record builded with old-DB subtitle
|
||
|
||
=item $olddb = &MARCmarc2koha($dbh,$MARCRecord);
|
||
|
||
builds a hash with old-db datas from a MARC::Record
|
||
|
||
=item &MARCaddbiblio($dbh,$MARC::Record,$biblionumber);
|
||
|
||
creates a biblio (in the MARC tables only). $biblionumber is the old-db biblionumber of the biblio
|
||
|
||
=item &MARCaddsubfield($dbh,$bibid,$tagid,$indicator,$tagorder,$subfieldcode,$subfieldorder,$subfieldvalue);
|
||
|
||
adds a subfield in a biblio (in the MARC tables only).
|
||
|
||
=item $MARCRecord = &MARCgetbiblio($dbh,$bibid);
|
||
|
||
Returns a MARC::Record for the biblio $bibid.
|
||
|
||
=item &MARCmodbiblio($dbh,$bibid,$record,$frameworkcode,$delete);
|
||
|
||
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);
|
||
|
||
MARCmodsubfield changes the value of a given subfield
|
||
|
||
=item $subfieldid = &MARCfindsubfield($dbh,$bibid,$tag,$subfieldcode,$subfieldorder,$subfieldvalue);
|
||
|
||
MARCfindsubfield returns a subfield number given a bibid/tag/subfieldvalue values.
|
||
Returns -1 if more than 1 answer
|
||
|
||
=item $subfieldid = &MARCfindsubfieldid($dbh,$bibid,$tag,$tagorder,$subfield,$subfieldorder);
|
||
|
||
MARCfindsubfieldid find a subfieldid for a bibid/tag/tagorder/subfield/subfieldorder
|
||
|
||
=item &MARCdelbiblio($dbh,$bibid);
|
||
|
||
MARCdelbiblio delete biblio $bibid
|
||
|
||
=cut
|
||
|
||
sub MARCgettagslib {
|
||
my ( $dbh, $forlibrarian, $frameworkcode ) = @_;
|
||
$frameworkcode = "" unless $frameworkcode;
|
||
my $sth;
|
||
my $libfield = ( $forlibrarian eq 1 ) ? 'liblibrarian' : 'libopac';
|
||
|
||
# check that framework exists
|
||
$sth =
|
||
$dbh->prepare(
|
||
"select count(*) from marc_tag_structure where frameworkcode=?");
|
||
$sth->execute($frameworkcode);
|
||
my ($total) = $sth->fetchrow;
|
||
$frameworkcode = "" unless ( $total > 0 );
|
||
$sth =
|
||
$dbh->prepare(
|
||
"select tagfield,liblibrarian,libopac,mandatory,repeatable from marc_tag_structure where frameworkcode=? order by tagfield"
|
||
);
|
||
$sth->execute($frameworkcode);
|
||
my ( $liblibrarian, $libopac, $tag, $res, $tab, $mandatory, $repeatable );
|
||
|
||
while ( ( $tag, $liblibrarian, $libopac, $mandatory, $repeatable ) = $sth->fetchrow ) {
|
||
$res->{$tag}->{lib} = ($forlibrarian or !$libopac)?$liblibrarian:$libopac;
|
||
$res->{$tab}->{tab} = ""; # XXX
|
||
$res->{$tag}->{mandatory} = $mandatory;
|
||
$res->{$tag}->{repeatable} = $repeatable;
|
||
}
|
||
|
||
$sth =
|
||
$dbh->prepare(
|
||
"select tagfield,tagsubfield,liblibrarian,libopac,tab, mandatory, repeatable,authorised_value,authtypecode,value_builder,kohafield,seealso,hidden,isurl,link from marc_subfield_structure where frameworkcode=? order by tagfield,tagsubfield"
|
||
);
|
||
$sth->execute($frameworkcode);
|
||
|
||
my $subfield;
|
||
my $authorised_value;
|
||
my $authtypecode;
|
||
my $value_builder;
|
||
my $kohafield;
|
||
my $seealso;
|
||
my $hidden;
|
||
my $isurl;
|
||
my $link;
|
||
|
||
while (
|
||
( $tag, $subfield, $liblibrarian, , $libopac, $tab,
|
||
$mandatory, $repeatable, $authorised_value, $authtypecode,
|
||
$value_builder, $kohafield, $seealso, $hidden,
|
||
$isurl, $link )
|
||
= $sth->fetchrow
|
||
)
|
||
{
|
||
$res->{$tag}->{$subfield}->{lib} = ($forlibrarian or !$libopac)?$liblibrarian:$libopac;
|
||
$res->{$tag}->{$subfield}->{tab} = $tab;
|
||
$res->{$tag}->{$subfield}->{mandatory} = $mandatory;
|
||
$res->{$tag}->{$subfield}->{repeatable} = $repeatable;
|
||
$res->{$tag}->{$subfield}->{authorised_value} = $authorised_value;
|
||
$res->{$tag}->{$subfield}->{authtypecode} = $authtypecode;
|
||
$res->{$tag}->{$subfield}->{value_builder} = $value_builder;
|
||
$res->{$tag}->{$subfield}->{kohafield} = $kohafield;
|
||
$res->{$tag}->{$subfield}->{seealso} = $seealso;
|
||
$res->{$tag}->{$subfield}->{hidden} = $hidden;
|
||
$res->{$tag}->{$subfield}->{isurl} = $isurl;
|
||
$res->{$tag}->{$subfield}->{link} = $link;
|
||
}
|
||
return $res;
|
||
}
|
||
|
||
sub MARCfind_marc_from_kohafield {
|
||
my ( $dbh, $kohafield,$frameworkcode ) = @_;
|
||
return 0, 0 unless $kohafield;
|
||
my $relations = C4::Context->marcfromkohafield;
|
||
return ($relations->{$frameworkcode}->{$kohafield}->[0],$relations->{$frameworkcode}->{$kohafield}->[1]);
|
||
}
|
||
|
||
|
||
sub MARCgetbiblio {
|
||
|
||
# Returns MARC::Record of the biblio passed in parameter.
|
||
my ( $dbh, $biblionumber ) = @_;
|
||
my $sth = $dbh->prepare('select marc from biblioitems where biblionumber=?');
|
||
$sth->execute($biblionumber);
|
||
my ($marc) = $sth->fetchrow;
|
||
my $record = MARC::File::USMARC::decode($marc);
|
||
return $record;
|
||
}
|
||
|
||
sub MARCgetitem {
|
||
|
||
my ( $dbh, $biblionumber, $itemnumber ) = @_;
|
||
my $frameworkcode=MARCfind_frameworkcode($dbh,$biblionumber);
|
||
# get the complete MARC record
|
||
my $sth = $dbh->prepare("select marc from biblioitems where biblionumber=?");
|
||
$sth->execute($biblionumber);
|
||
my ($rawmarc) = $sth->fetchrow;
|
||
my $record = MARC::File::USMARC::decode($rawmarc);
|
||
# now, find the relevant itemnumber
|
||
my ($itemnumberfield,$itemnumbersubfield) = MARCfind_marc_from_kohafield($dbh,'items.itemnumber',$frameworkcode);
|
||
# prepare the new item record
|
||
my $itemrecord = MARC::Record->new();
|
||
# parse all fields fields from the complete record
|
||
foreach ($record->field($itemnumberfield)) {
|
||
# when the item field is found, save it
|
||
if ($_->subfield($itemnumbersubfield) == $itemnumber) {
|
||
$itemrecord->append_fields($_);
|
||
}
|
||
}
|
||
|
||
return $itemrecord;
|
||
}
|
||
|
||
sub find_biblioitemnumber {
|
||
my ( $dbh, $biblionumber ) = @_;
|
||
my $sth = $dbh->prepare("select biblioitemnumber from biblioitems where biblionumber=?");
|
||
$sth->execute($biblionumber);
|
||
my ($biblioitemnumber) = $sth->fetchrow;
|
||
return $biblioitemnumber;
|
||
}
|
||
|
||
sub MARCfind_frameworkcode {
|
||
my ( $dbh, $biblionumber ) = @_;
|
||
my $sth = $dbh->prepare("select frameworkcode from biblio where biblionumber=?");
|
||
$sth->execute($biblionumber);
|
||
my ($frameworkcode) = $sth->fetchrow;
|
||
return $frameworkcode;
|
||
}
|
||
|
||
|
||
sub MARCkoha2marcBiblio {
|
||
|
||
# this function builds partial MARC::Record from the old koha-DB fields
|
||
my ( $dbh, $biblionumber, $biblioitemnumber ) = @_;
|
||
my $sth =
|
||
$dbh->prepare(
|
||
"select tagfield,tagsubfield from marc_subfield_structure where frameworkcode=? and kohafield=?"
|
||
);
|
||
my $record = MARC::Record->new();
|
||
|
||
#--- if bibid, then retrieve old-style koha data
|
||
if ( $biblionumber > 0 ) {
|
||
my $sth2 =
|
||
$dbh->prepare(
|
||
"select biblionumber,author,title,unititle,notes,abstract,serial,seriestitle,copyrightdate,timestamp
|
||
from biblio where biblionumber=?"
|
||
);
|
||
$sth2->execute($biblionumber);
|
||
my $row = $sth2->fetchrow_hashref;
|
||
my $code;
|
||
foreach $code ( keys %$row ) {
|
||
if ( $row->{$code} ) {
|
||
&MARCkoha2marcOnefield( $sth, $record, "biblio." . $code,
|
||
$row->{$code}, '');
|
||
}
|
||
}
|
||
}
|
||
|
||
#--- if biblioitem, then retrieve old-style koha data
|
||
if ( $biblioitemnumber > 0 ) {
|
||
my $sth2 =
|
||
$dbh->prepare(
|
||
" SELECT biblioitemnumber,biblionumber,volume,number,classification,
|
||
itemtype,url,isbn,issn,dewey,subclass,publicationyear,publishercode,
|
||
volumedate,volumeddesc,timestamp,illus,pages,notes AS bnotes,size,place
|
||
FROM biblioitems
|
||
WHERE biblioitemnumber=?
|
||
"
|
||
);
|
||
$sth2->execute($biblioitemnumber);
|
||
my $row = $sth2->fetchrow_hashref;
|
||
my $code;
|
||
foreach $code ( keys %$row ) {
|
||
if ( $row->{$code} ) {
|
||
&MARCkoha2marcOnefield( $sth, $record, "biblioitems." . $code,
|
||
$row->{$code},'' );
|
||
}
|
||
}
|
||
}
|
||
|
||
# other fields => additional authors, subjects, subtitles
|
||
my $sth2 =
|
||
$dbh->prepare(
|
||
" SELECT author FROM additionalauthors WHERE biblionumber=?");
|
||
$sth2->execute($biblionumber);
|
||
while ( my $row = $sth2->fetchrow_hashref ) {
|
||
&MARCkoha2marcOnefield( $sth, $record, "additionalauthors.author",
|
||
$row->{'author'},'' );
|
||
}
|
||
$sth2 =
|
||
$dbh->prepare(" SELECT subject FROM bibliosubject WHERE biblionumber=?");
|
||
$sth2->execute($biblionumber);
|
||
while ( my $row = $sth2->fetchrow_hashref ) {
|
||
&MARCkoha2marcOnefield( $sth, $record, "bibliosubject.subject",
|
||
$row->{'subject'},'' );
|
||
}
|
||
$sth2 =
|
||
$dbh->prepare(
|
||
" SELECT subtitle FROM bibliosubtitle WHERE biblionumber=?");
|
||
$sth2->execute($biblionumber);
|
||
while ( my $row = $sth2->fetchrow_hashref ) {
|
||
&MARCkoha2marcOnefield( $sth, $record, "bibliosubtitle.subtitle",
|
||
$row->{'subtitle'},'' );
|
||
}
|
||
return $record;
|
||
}
|
||
|
||
sub MARCkoha2marcItem {
|
||
|
||
# this function builds partial MARC::Record from the old koha-DB fields
|
||
my ( $dbh, $biblionumber, $itemnumber ) = @_;
|
||
|
||
# my $dbh=&C4Connect;
|
||
my $sth =
|
||
$dbh->prepare(
|
||
"select tagfield,tagsubfield from marc_subfield_structure where frameworkcode=? and kohafield=?"
|
||
);
|
||
my $record = MARC::Record->new();
|
||
|
||
#--- if item, then retrieve old-style koha data
|
||
if ( $itemnumber > 0 ) {
|
||
|
||
# print STDERR "prepare $biblionumber,$itemnumber\n";
|
||
my $sth2 =
|
||
$dbh->prepare(
|
||
"SELECT itemnumber,biblionumber,multivolumepart,biblioitemnumber,barcode,dateaccessioned,
|
||
booksellerid,homebranch,price,replacementprice,replacementpricedate,datelastborrowed,
|
||
datelastseen,multivolume,stack,notforloan,itemlost,wthdrawn,itemcallnumber,issues,renewals,
|
||
reserves,restricted,binding,itemnotes,holdingbranch,timestamp
|
||
FROM items
|
||
WHERE itemnumber=?"
|
||
);
|
||
$sth2->execute($itemnumber);
|
||
my $row = $sth2->fetchrow_hashref;
|
||
my $code;
|
||
foreach $code ( keys %$row ) {
|
||
if ( $row->{$code} ) {
|
||
&MARCkoha2marcOnefield( $sth, $record, "items." . $code,
|
||
$row->{$code},'' );
|
||
}
|
||
}
|
||
}
|
||
return $record;
|
||
}
|
||
|
||
sub MARCkoha2marcSubtitle {
|
||
|
||
# this function builds partial MARC::Record from the old koha-DB fields
|
||
my ( $dbh, $bibnum, $subtitle ) = @_;
|
||
my $sth =
|
||
$dbh->prepare(
|
||
"select tagfield,tagsubfield from marc_subfield_structure where frameworkcode=? and kohafield=?"
|
||
);
|
||
my $record = MARC::Record->new();
|
||
&MARCkoha2marcOnefield( $sth, $record, "bibliosubtitle.subtitle",
|
||
$subtitle,'' );
|
||
return $record;
|
||
}
|
||
|
||
sub MARCkoha2marcOnefield {
|
||
my ( $sth, $record, $kohafieldname, $value,$frameworkcode ) = @_;
|
||
my $tagfield;
|
||
my $tagsubfield;
|
||
$sth->execute($frameworkcode,$kohafieldname);
|
||
if ( ( $tagfield, $tagsubfield ) = $sth->fetchrow ) {
|
||
if ( $record->field($tagfield) ) {
|
||
my $tag = $record->field($tagfield);
|
||
if ($tag) {
|
||
$tag->add_subfields( $tagsubfield, $value );
|
||
$record->delete_field($tag);
|
||
$record->add_fields($tag);
|
||
}
|
||
}
|
||
else {
|
||
$record->add_fields( $tagfield, " ", " ", $tagsubfield => $value );
|
||
}
|
||
}
|
||
return $record;
|
||
}
|
||
|
||
sub MARChtml2marc {
|
||
my ($dbh,$rtags,$rsubfields,$rvalues,%indicators) = @_;
|
||
my $prevtag = -1;
|
||
my $record = MARC::Record->new();
|
||
# my %subfieldlist=();
|
||
my $prevvalue; # if tag <10
|
||
my $field; # if tag >=10
|
||
for (my $i=0; $i< @$rtags; $i++) {
|
||
next unless @$rvalues[$i];
|
||
# rebuild MARC::Record
|
||
# warn "0=>".@$rtags[$i].@$rsubfields[$i]." = ".@$rvalues[$i].": ";
|
||
if (@$rtags[$i] ne $prevtag) {
|
||
if ($prevtag < 10) {
|
||
if ($prevvalue) {
|
||
if ($prevtag ne '000') {
|
||
$record->add_fields((sprintf "%03s",$prevtag),$prevvalue);
|
||
} else {
|
||
$record->leader($prevvalue);
|
||
}
|
||
}
|
||
} else {
|
||
if ($field) {
|
||
$record->add_fields($field);
|
||
}
|
||
}
|
||
$indicators{@$rtags[$i]}.=' ';
|
||
if (@$rtags[$i] <10) {
|
||
$prevvalue= @$rvalues[$i];
|
||
undef $field;
|
||
} else {
|
||
undef $prevvalue;
|
||
$field = MARC::Field->new( (sprintf "%03s",@$rtags[$i]), substr($indicators{@$rtags[$i]},0,1),substr($indicators{@$rtags[$i]},1,1), @$rsubfields[$i] => @$rvalues[$i]);
|
||
# warn "1=>".@$rtags[$i].@$rsubfields[$i]." = ".@$rvalues[$i].": ".$field->as_formatted;
|
||
}
|
||
$prevtag = @$rtags[$i];
|
||
} else {
|
||
if (@$rtags[$i] <10) {
|
||
$prevvalue=@$rvalues[$i];
|
||
} else {
|
||
if (length(@$rvalues[$i])>0) {
|
||
$field->add_subfields(@$rsubfields[$i] => @$rvalues[$i]);
|
||
# warn "2=>".@$rtags[$i].@$rsubfields[$i]." = ".@$rvalues[$i].": ".$field->as_formatted;
|
||
}
|
||
}
|
||
$prevtag= @$rtags[$i];
|
||
}
|
||
}
|
||
# the last has not been included inside the loop... do it now !
|
||
$record->add_fields($field) if $field;
|
||
# warn "HTML2MARC=".$record->as_formatted;
|
||
return $record;
|
||
}
|
||
|
||
sub MARCmarc2koha {
|
||
my ($dbh,$record,$frameworkcode) = @_;
|
||
my $sth=$dbh->prepare("select tagfield,tagsubfield from marc_subfield_structure where frameworkcode=? and kohafield=?");
|
||
my $result;
|
||
my $sth2=$dbh->prepare("SHOW COLUMNS from biblio");
|
||
$sth2->execute;
|
||
my $field;
|
||
while (($field)=$sth2->fetchrow) {
|
||
$result=&MARCmarc2kohaOneField($sth,"biblio",$field,$record,$result,$frameworkcode);
|
||
}
|
||
$sth2=$dbh->prepare("SHOW COLUMNS from biblioitems");
|
||
$sth2->execute;
|
||
while (($field)=$sth2->fetchrow) {
|
||
if ($field eq 'notes') { $field = 'bnotes'; }
|
||
$result=&MARCmarc2kohaOneField($sth,"biblioitems",$field,$record,$result,$frameworkcode);
|
||
}
|
||
$sth2=$dbh->prepare("SHOW COLUMNS from items");
|
||
$sth2->execute;
|
||
while (($field)=$sth2->fetchrow) {
|
||
$result=&MARCmarc2kohaOneField($sth,"items",$field,$record,$result,$frameworkcode);
|
||
}
|
||
# additional authors : specific
|
||
$result = &MARCmarc2kohaOneField($sth,"bibliosubtitle","subtitle",$record,$result,$frameworkcode);
|
||
$result = &MARCmarc2kohaOneField($sth,"additionalauthors","additionalauthors",$record,$result,$frameworkcode);
|
||
# modify copyrightdate to keep only the 1st year found
|
||
my $temp = $result->{'copyrightdate'};
|
||
$temp =~ m/c(\d\d\d\d)/; # search cYYYY first
|
||
if ($1>0) {
|
||
$result->{'copyrightdate'} = $1;
|
||
} else { # if no cYYYY, get the 1st date.
|
||
$temp =~ m/(\d\d\d\d)/;
|
||
$result->{'copyrightdate'} = $1;
|
||
}
|
||
# modify publicationyear to keep only the 1st year found
|
||
$temp = $result->{'publicationyear'};
|
||
$temp =~ m/c(\d\d\d\d)/; # search cYYYY first
|
||
if ($1>0) {
|
||
$result->{'publicationyear'} = $1;
|
||
} else { # if no cYYYY, get the 1st date.
|
||
$temp =~ m/(\d\d\d\d)/;
|
||
$result->{'publicationyear'} = $1;
|
||
}
|
||
return $result;
|
||
}
|
||
|
||
sub MARCmarc2kohaOneField {
|
||
|
||
# FIXME ? if a field has a repeatable subfield that is used in old-db, only the 1st will be retrieved...
|
||
my ( $sth, $kohatable, $kohafield, $record, $result,$frameworkcode ) = @_;
|
||
# warn "kohatable / $kohafield / $result / ";
|
||
my $res = "";
|
||
my $tagfield;
|
||
my $subfield;
|
||
( $tagfield, $subfield ) = MARCfind_marc_from_kohafield("",$kohatable.".".$kohafield,$frameworkcode);
|
||
foreach my $field ( $record->field($tagfield) ) {
|
||
if ($field->tag()<10) {
|
||
if ($result->{$kohafield}) {
|
||
$result->{$kohafield} .= " | ".$field->data();
|
||
} else {
|
||
$result->{$kohafield} = $field->data();
|
||
}
|
||
} else {
|
||
if ( $field->subfields ) {
|
||
my @subfields = $field->subfields();
|
||
foreach my $subfieldcount ( 0 .. $#subfields ) {
|
||
if ($subfields[$subfieldcount][0] eq $subfield) {
|
||
if ( $result->{$kohafield} ) {
|
||
$result->{$kohafield} .= " | " . $subfields[$subfieldcount][1];
|
||
}
|
||
else {
|
||
$result->{$kohafield} = $subfields[$subfieldcount][1];
|
||
}
|
||
}
|
||
}
|
||
}
|
||
}
|
||
}
|
||
# warn "OneField for $kohatable.$kohafield and $frameworkcode=> $tagfield, $subfield";
|
||
return $result;
|
||
}
|
||
|
||
#
|
||
#
|
||
# 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,$frameworkcode);
|
||
|
||
creates a biblio from a MARC::Record.
|
||
|
||
=item NEWnewitem($dbh, $record,$bibid);
|
||
|
||
creates an item from a MARC::Record
|
||
|
||
=cut
|
||
|
||
sub NEWnewbiblio {
|
||
my ( $dbh, $record, $frameworkcode ) = @_;
|
||
my $biblionumber;
|
||
my $biblioitemnumber;
|
||
my $olddata = MARCmarc2koha( $dbh, $record,$frameworkcode );
|
||
$olddata->{frameworkcode} = $frameworkcode;
|
||
$biblionumber = OLDnewbiblio( $dbh, $olddata );
|
||
$olddata->{biblionumber} = $biblionumber;
|
||
# add biblionumber into the MARC record (it's the ID for zebra)
|
||
my ( $tagfield, $tagsubfield ) =
|
||
MARCfind_marc_from_kohafield( $dbh, "biblio.biblionumber",$frameworkcode );
|
||
# create the field
|
||
my $newfield;
|
||
if ($tagfield<10) {
|
||
$newfield = MARC::Field->new(
|
||
$tagfield, $biblionumber,
|
||
);
|
||
} else {
|
||
$newfield = MARC::Field->new(
|
||
$tagfield, '', '', "$tagsubfield" => $biblionumber,
|
||
);
|
||
}
|
||
# drop old field (just in case it already exist and create new one...
|
||
my $old_field = $record->field($tagfield);
|
||
$record->delete_field($old_field);
|
||
$record->add_fields($newfield);
|
||
|
||
#create the marc entry, that stores the rax marc record in Koha 3.0
|
||
$olddata->{marc} = $record->as_usmarc();
|
||
$olddata->{marcxml} = $record->as_xml();
|
||
# and create biblioitem, that's all folks !
|
||
$biblioitemnumber = OLDnewbiblioitem( $dbh, $olddata );
|
||
|
||
# search subtiles, addiauthors and subjects
|
||
( $tagfield, $tagsubfield ) =
|
||
MARCfind_marc_from_kohafield( $dbh, "additionalauthors.author",$frameworkcode );
|
||
my @addiauthfields = $record->field($tagfield);
|
||
foreach my $addiauthfield (@addiauthfields) {
|
||
my @addiauthsubfields = $addiauthfield->subfield($tagsubfield);
|
||
foreach my $subfieldcount ( 0 .. $#addiauthsubfields ) {
|
||
OLDmodaddauthor( $dbh, $biblionumber,
|
||
$addiauthsubfields[$subfieldcount] );
|
||
}
|
||
}
|
||
( $tagfield, $tagsubfield ) =
|
||
MARCfind_marc_from_kohafield( $dbh, "bibliosubtitle.subtitle",$frameworkcode );
|
||
my @subtitlefields = $record->field($tagfield);
|
||
foreach my $subtitlefield (@subtitlefields) {
|
||
my @subtitlesubfields = $subtitlefield->subfield($tagsubfield);
|
||
foreach my $subfieldcount ( 0 .. $#subtitlesubfields ) {
|
||
OLDnewsubtitle( $dbh, $biblionumber,
|
||
$subtitlesubfields[$subfieldcount] );
|
||
}
|
||
}
|
||
( $tagfield, $tagsubfield ) =
|
||
MARCfind_marc_from_kohafield( $dbh, "bibliosubject.subject",$frameworkcode );
|
||
my @subj = $record->field($tagfield);
|
||
my @subjects;
|
||
foreach my $subject (@subj) {
|
||
my @subjsubfield = $subject->subfield($tagsubfield);
|
||
foreach my $subfieldcount ( 0 .. $#subjsubfield ) {
|
||
push @subjects, $subjsubfield[$subfieldcount];
|
||
}
|
||
}
|
||
OLDmodsubject( $dbh, $biblionumber, 1, @subjects );
|
||
return ( $biblionumber, $biblioitemnumber );
|
||
}
|
||
|
||
sub NEWmodbiblioframework {
|
||
my ($dbh,$biblionumber,$frameworkcode) =@_;
|
||
my $sth = $dbh->prepare("Update biblio SET frameworkcode=? WHERE biblionumber=?");
|
||
$sth->execute($frameworkcode,$biblionumber);
|
||
return 1;
|
||
}
|
||
|
||
sub NEWmodbiblio {
|
||
my ($dbh,$record,$biblionumber,$frameworkcode) =@_;
|
||
$frameworkcode="" unless $frameworkcode;
|
||
# &MARCmodbiblio($dbh,$bibid,$record,$frameworkcode,0);
|
||
my $oldbiblio = MARCmarc2koha($dbh,$record,$frameworkcode);
|
||
|
||
$oldbiblio->{frameworkcode} = $frameworkcode;
|
||
#create the marc entry, that stores the rax marc record in Koha 3.0
|
||
$oldbiblio->{marc} = $record->as_usmarc();
|
||
$oldbiblio->{marcxml} = $record->as_xml();
|
||
|
||
OLDmodbiblio($dbh,$oldbiblio);
|
||
OLDmodbibitem($dbh,$oldbiblio);
|
||
# now, modify addi authors, subject, addititles.
|
||
my ($tagfield,$tagsubfield) = MARCfind_marc_from_kohafield($dbh,"additionalauthors.author",$frameworkcode);
|
||
my @addiauthfields = $record->field($tagfield);
|
||
foreach my $addiauthfield (@addiauthfields) {
|
||
my @addiauthsubfields = $addiauthfield->subfield($tagsubfield);
|
||
foreach my $subfieldcount (0..$#addiauthsubfields) {
|
||
OLDmodaddauthor($dbh,$biblionumber,$addiauthsubfields[$subfieldcount]);
|
||
}
|
||
}
|
||
($tagfield,$tagsubfield) = MARCfind_marc_from_kohafield($dbh,"bibliosubtitle.subtitle",$frameworkcode);
|
||
my @subtitlefields = $record->field($tagfield);
|
||
foreach my $subtitlefield (@subtitlefields) {
|
||
my @subtitlesubfields = $subtitlefield->subfield($tagsubfield);
|
||
# delete & create subtitle again because OLDmodsubtitle can't handle new subtitles
|
||
# between 2 modifs
|
||
$dbh->do("delete from bibliosubtitle where biblionumber=$biblionumber");
|
||
foreach my $subfieldcount (0..$#subtitlesubfields) {
|
||
foreach my $subtit(split /\||#/,$subtitlesubfields[$subfieldcount]) {
|
||
OLDnewsubtitle($dbh,$biblionumber,$subtit);
|
||
}
|
||
}
|
||
}
|
||
($tagfield,$tagsubfield) = MARCfind_marc_from_kohafield($dbh,"bibliosubject.subject",$frameworkcode);
|
||
my @subj = $record->field($tagfield);
|
||
my @subjects;
|
||
foreach my $subject (@subj) {
|
||
my @subjsubfield = $subject->subfield($tagsubfield);
|
||
foreach my $subfieldcount (0..$#subjsubfield) {
|
||
push @subjects,$subjsubfield[$subfieldcount];
|
||
}
|
||
}
|
||
OLDmodsubject($dbh,$biblionumber,1,@subjects);
|
||
return 1;
|
||
}
|
||
|
||
sub NEWdelbiblio {
|
||
my ( $dbh, $bibid ) = @_;
|
||
my $biblio = &MARCfind_oldbiblionumber_from_MARCbibid( $dbh, $bibid );
|
||
&OLDdelbiblio( $dbh, $biblio );
|
||
my $sth =
|
||
$dbh->prepare(
|
||
"select biblioitemnumber from biblioitems where biblionumber=?");
|
||
$sth->execute($biblio);
|
||
while ( my ($biblioitemnumber) = $sth->fetchrow ) {
|
||
OLDdeletebiblioitem( $dbh, $biblioitemnumber );
|
||
}
|
||
&MARCdelbiblio( $dbh, $bibid, 0 );
|
||
}
|
||
|
||
sub NEWnewitem {
|
||
my ( $dbh, $record, $biblionumber, $biblioitemnumber ) = @_;
|
||
|
||
# add item in old-DB
|
||
my $frameworkcode=MARCfind_frameworkcode($dbh,$biblionumber);
|
||
my $item = &MARCmarc2koha( $dbh, $record,$frameworkcode );
|
||
# needs old biblionumber and biblioitemnumber
|
||
$item->{'biblionumber'} = $biblionumber;
|
||
$item->{'biblioitemnumber'}=$biblioitemnumber;
|
||
$item->{marc} = $record->as_usmarc();
|
||
my ( $itemnumber, $error ) = &OLDnewitems( $dbh, $item, $item->{barcode} );
|
||
return $itemnumber;
|
||
}
|
||
|
||
sub NEWmoditem {
|
||
my ( $dbh, $record, $biblionumber, $biblioitemnumber, $itemnumber, $delete ) = @_;
|
||
|
||
# &MARCmoditem( $dbh, $record, $bibid, $itemnumber, $delete );
|
||
my $frameworkcode=MARCfind_frameworkcode($dbh,$biblionumber);
|
||
my $olditem = MARCmarc2koha( $dbh, $record,$frameworkcode );
|
||
# add MARC record
|
||
$olditem->{marc} = $record->as_usmarc();
|
||
$olditem->{biblionumber} = $biblionumber;
|
||
$olditem->{biblioitemnumber} = $biblioitemnumber;
|
||
# and modify item
|
||
OLDmoditem( $dbh, $olditem );
|
||
}
|
||
|
||
sub NEWdelitem {
|
||
my ( $dbh, $bibid, $itemnumber ) = @_;
|
||
my $biblio = &MARCfind_oldbiblionumber_from_MARCbibid( $dbh, $bibid );
|
||
&OLDdelitem( $dbh, $itemnumber );
|
||
&MARCdelitem( $dbh, $bibid, $itemnumber );
|
||
}
|
||
|
||
#
|
||
#
|
||
# OLD OLD OLD OLD OLD OLD OLD OLD OLD OLD OLD OLD OLD OLD OLD OLD OLD
|
||
#
|
||
#
|
||
|
||
=item $biblionumber = OLDnewbiblio($dbh,$biblio);
|
||
|
||
adds a record in biblio table. Datas are in the hash $biblio.
|
||
|
||
=item $biblionumber = OLDmodbiblio($dbh,$biblio);
|
||
|
||
modify a record in biblio table. Datas are in the hash $biblio.
|
||
|
||
=item OLDmodsubtitle($dbh,$bibnum,$subtitle);
|
||
|
||
modify subtitles in bibliosubtitle table.
|
||
|
||
=item OLDmodaddauthor($dbh,$bibnum,$author);
|
||
|
||
adds or modify additional authors
|
||
NOTE : Strange sub : seems to delete MANY and add only ONE author... maybe buggy ?
|
||
|
||
=item $errors = OLDmodsubject($dbh,$bibnum, $force, @subject);
|
||
|
||
modify/adds subjects
|
||
|
||
=item OLDmodbibitem($dbh, $biblioitem);
|
||
|
||
modify a biblioitem
|
||
|
||
=item OLDmodnote($dbh,$bibitemnum,$note
|
||
|
||
modify a note for a biblioitem
|
||
|
||
=item OLDnewbiblioitem($dbh,$biblioitem);
|
||
|
||
adds a biblioitem ($biblioitem is a hash with the values)
|
||
|
||
=item OLDnewsubject($dbh,$bibnum);
|
||
|
||
adds a subject
|
||
|
||
=item OLDnewsubtitle($dbh,$bibnum,$subtitle);
|
||
|
||
create a new subtitle
|
||
|
||
=item ($itemnumber,$errors)= OLDnewitems($dbh,$item,$barcode);
|
||
|
||
create a item. $item is a hash and $barcode the barcode.
|
||
|
||
=item OLDmoditem($dbh,$item);
|
||
|
||
modify item
|
||
|
||
=item OLDdelitem($dbh,$itemnum);
|
||
|
||
delete item
|
||
|
||
=item OLDdeletebiblioitem($dbh,$biblioitemnumber);
|
||
|
||
deletes a biblioitem
|
||
NOTE : not standard sub name. Should be OLDdelbiblioitem()
|
||
|
||
=item OLDdelbiblio($dbh,$biblio);
|
||
|
||
delete a biblio
|
||
|
||
=cut
|
||
|
||
sub OLDnewbiblio {
|
||
my ( $dbh, $biblio ) = @_;
|
||
|
||
$dbh->do('lock tables biblio WRITE');
|
||
my $sth = $dbh->prepare("Select max(biblionumber) from biblio");
|
||
$sth->execute;
|
||
my $data = $sth->fetchrow_arrayref;
|
||
my $bibnum = $$data[0] + 1;
|
||
my $series = 0;
|
||
|
||
if ( $biblio->{'seriestitle'} ) { $series = 1 }
|
||
$sth->finish;
|
||
$sth =
|
||
$dbh->prepare("insert into biblio set biblionumber=?, title=?, author=?, copyrightdate=?,
|
||
serial=?, seriestitle=?, notes=?, abstract=?,
|
||
unititle=?"
|
||
);
|
||
$sth->execute(
|
||
$bibnum, $biblio->{'title'},
|
||
$biblio->{'author'}, $biblio->{'copyrightdate'},
|
||
$biblio->{'serial'}, $biblio->{'seriestitle'},
|
||
$biblio->{'notes'}, $biblio->{'abstract'},
|
||
$biblio->{'unititle'}
|
||
);
|
||
|
||
$sth->finish;
|
||
$dbh->do('unlock tables');
|
||
return ($bibnum);
|
||
}
|
||
|
||
sub OLDmodbiblio {
|
||
my ( $dbh, $biblio ) = @_;
|
||
my $sth = $dbh->prepare("Update biblio set title=?, author=?, abstract=?, copyrightdate=?,
|
||
seriestitle=?, serial=?, unititle=?, notes=?, frameworkcode=?
|
||
where biblionumber = ?"
|
||
);
|
||
$sth->execute(
|
||
$biblio->{'title'}, $biblio->{'author'},
|
||
$biblio->{'abstract'}, $biblio->{'copyrightdate'},
|
||
$biblio->{'seriestitle'}, $biblio->{'serial'},
|
||
$biblio->{'unititle'}, $biblio->{'notes'},
|
||
$biblio->{frameworkcode},
|
||
$biblio->{'biblionumber'}
|
||
);
|
||
$sth->finish;
|
||
return ( $biblio->{'biblionumber'} );
|
||
} # sub modbiblio
|
||
|
||
sub OLDmodsubtitle {
|
||
my ( $dbh, $bibnum, $subtitle ) = @_;
|
||
my $sth =
|
||
$dbh->prepare(
|
||
"update bibliosubtitle set subtitle = ? where biblionumber = ?");
|
||
$sth->execute( $subtitle, $bibnum );
|
||
$sth->finish;
|
||
} # sub modsubtitle
|
||
|
||
sub OLDmodaddauthor {
|
||
my ( $dbh, $bibnum, @authors ) = @_;
|
||
|
||
# my $dbh = C4Connect;
|
||
my $sth =
|
||
$dbh->prepare("Delete from additionalauthors where biblionumber = ?");
|
||
|
||
$sth->execute($bibnum);
|
||
$sth->finish;
|
||
foreach my $author (@authors) {
|
||
if ( $author ne '' ) {
|
||
$sth =
|
||
$dbh->prepare(
|
||
"Insert into additionalauthors set author = ?, biblionumber = ?"
|
||
);
|
||
|
||
$sth->execute( $author, $bibnum );
|
||
|
||
$sth->finish;
|
||
} # if
|
||
}
|
||
} # sub modaddauthor
|
||
|
||
sub OLDmodsubject {
|
||
my ( $dbh, $bibnum, $force, @subject ) = @_;
|
||
|
||
# my $dbh = C4Connect;
|
||
my $count = @subject;
|
||
my $error;
|
||
for ( my $i = 0 ; $i < $count ; $i++ ) {
|
||
$subject[$i] =~ s/^ //g;
|
||
$subject[$i] =~ s/ $//g;
|
||
my $sth =
|
||
$dbh->prepare(
|
||
"select * from catalogueentry where entrytype = 's' and catalogueentry = ?"
|
||
);
|
||
$sth->execute( $subject[$i] );
|
||
|
||
if ( my $data = $sth->fetchrow_hashref ) {
|
||
}
|
||
else {
|
||
if ( $force eq $subject[$i] || $force == 1 ) {
|
||
|
||
# subject not in aut, chosen to force anway
|
||
# so insert into cataloguentry so its in auth file
|
||
my $sth2 =
|
||
$dbh->prepare(
|
||
"Insert into catalogueentry (entrytype,catalogueentry) values ('s',?)"
|
||
);
|
||
|
||
$sth2->execute( $subject[$i] ) if ( $subject[$i] );
|
||
$sth2->finish;
|
||
}
|
||
else {
|
||
$error =
|
||
"$subject[$i]\n does not exist in the subject authority file";
|
||
my $sth2 =
|
||
$dbh->prepare(
|
||
"Select * from catalogueentry where entrytype = 's' and (catalogueentry like ? or catalogueentry like ? or catalogueentry like ?)"
|
||
);
|
||
$sth2->execute( "$subject[$i] %", "% $subject[$i] %",
|
||
"% $subject[$i]" );
|
||
while ( my $data = $sth2->fetchrow_hashref ) {
|
||
$error .= "<br>$data->{'catalogueentry'}";
|
||
} # while
|
||
$sth2->finish;
|
||
} # else
|
||
} # else
|
||
$sth->finish;
|
||
} # else
|
||
if ( $error eq '' ) {
|
||
my $sth =
|
||
$dbh->prepare("Delete from bibliosubject where biblionumber = ?");
|
||
$sth->execute($bibnum);
|
||
$sth->finish;
|
||
$sth =
|
||
$dbh->prepare(
|
||
"Insert into bibliosubject (subject,biblionumber) values (?,?)");
|
||
my $query;
|
||
foreach $query (@subject) {
|
||
$sth->execute( $query, $bibnum ) if ( $query && $bibnum );
|
||
} # foreach
|
||
$sth->finish;
|
||
} # if
|
||
|
||
# $dbh->disconnect;
|
||
return ($error);
|
||
} # sub modsubject
|
||
|
||
sub OLDmodbibitem {
|
||
my ( $dbh, $biblioitem ) = @_;
|
||
my $query;
|
||
|
||
my $sth = $dbh->prepare("update biblioitems set itemtype=?, url=?, isbn=?, issn=?,
|
||
publishercode=?, publicationyear=?, classification=?, dewey=?,
|
||
subclass=?, illus=?, pages=?, volumeddesc=?,
|
||
notes=?, size=?, place=?, marc=?,
|
||
marcxml=?
|
||
where biblioitemnumber=?");
|
||
$sth->execute( $biblioitem->{itemtype}, $biblioitem->{url}, $biblioitem->{isbn}, $biblioitem->{issn},
|
||
$biblioitem->{publishercode}, $biblioitem->{publicationyear}, $biblioitem->{classification}, $biblioitem->{dewey},
|
||
$biblioitem->{subclass}, $biblioitem->{illus}, $biblioitem->{pages}, $biblioitem->{volumeddesc},
|
||
$biblioitem->{bnotes}, $biblioitem->{size}, $biblioitem->{place}, $biblioitem->{marc},
|
||
$biblioitem->{marcxml}, $biblioitem->{biblioitemnumber});
|
||
# warn "MOD : $biblioitem->{biblioitemnumber} = ".$biblioitem->{marc};
|
||
} # sub modbibitem
|
||
|
||
sub OLDmodnote {
|
||
my ( $dbh, $bibitemnum, $note ) = @_;
|
||
|
||
# my $dbh=C4Connect;
|
||
my $query = "update biblioitems set notes='$note' where
|
||
biblioitemnumber='$bibitemnum'";
|
||
my $sth = $dbh->prepare($query);
|
||
$sth->execute;
|
||
$sth->finish;
|
||
|
||
# $dbh->disconnect;
|
||
}
|
||
|
||
sub OLDnewbiblioitem {
|
||
my ( $dbh, $biblioitem ) = @_;
|
||
|
||
$dbh->do("lock tables biblioitems WRITE, biblio WRITE");
|
||
my $sth = $dbh->prepare("Select max(biblioitemnumber) from biblioitems");
|
||
my $data;
|
||
my $biblioitemnumber;
|
||
|
||
$sth->execute;
|
||
$data = $sth->fetchrow_arrayref;
|
||
$biblioitemnumber = $$data[0] + 1;
|
||
|
||
# Insert biblioitemnumber in MARC record, we need it to manage items later...
|
||
my $frameworkcode=MARCfind_frameworkcode($dbh,$biblioitem->{biblionumber});
|
||
my ($biblioitemnumberfield,$biblioitemnumbersubfield) = MARCfind_marc_from_kohafield($dbh,'biblioitems.biblioitemnumber',$frameworkcode);
|
||
my $record = MARC::File::USMARC::decode($biblioitem->{marc});
|
||
my $field=$record->field($biblioitemnumberfield);
|
||
$field->update($biblioitemnumbersubfield => "$biblioitemnumber");
|
||
$biblioitem->{marc} = $record->as_usmarc();
|
||
$biblioitem->{marcxml} = $record->as_xml();
|
||
|
||
$sth = $dbh->prepare( "insert into biblioitems set
|
||
biblioitemnumber = ?, biblionumber = ?,
|
||
volume = ?, number = ?,
|
||
classification = ?, itemtype = ?,
|
||
url = ?, isbn = ?,
|
||
issn = ?, dewey = ?,
|
||
subclass = ?, publicationyear = ?,
|
||
publishercode = ?, volumedate = ?,
|
||
volumeddesc = ?, illus = ?,
|
||
pages = ?, notes = ?,
|
||
size = ?, lccn = ?,
|
||
marc = ?, place = ?,
|
||
marcxml = ?"
|
||
);
|
||
$sth->execute(
|
||
$biblioitemnumber, $biblioitem->{'biblionumber'},
|
||
$biblioitem->{'volume'}, $biblioitem->{'number'},
|
||
$biblioitem->{'classification'}, $biblioitem->{'itemtype'},
|
||
$biblioitem->{'url'}, $biblioitem->{'isbn'},
|
||
$biblioitem->{'issn'}, $biblioitem->{'dewey'},
|
||
$biblioitem->{'subclass'}, $biblioitem->{'publicationyear'},
|
||
$biblioitem->{'publishercode'}, $biblioitem->{'volumedate'},
|
||
$biblioitem->{'volumeddesc'}, $biblioitem->{'illus'},
|
||
$biblioitem->{'pages'}, $biblioitem->{'bnotes'},
|
||
$biblioitem->{'size'}, $biblioitem->{'lccn'},
|
||
$biblioitem->{'marc'}, $biblioitem->{'place'},
|
||
$biblioitem->{marcxml},
|
||
);
|
||
$dbh->do("unlock tables");
|
||
return ($biblioitemnumber);
|
||
}
|
||
|
||
sub OLDnewsubject {
|
||
my ( $dbh, $bibnum ) = @_;
|
||
my $sth =
|
||
$dbh->prepare("insert into bibliosubject (biblionumber) values (?)");
|
||
$sth->execute($bibnum);
|
||
$sth->finish;
|
||
}
|
||
|
||
sub OLDnewsubtitle {
|
||
my ( $dbh, $bibnum, $subtitle ) = @_;
|
||
my $sth =
|
||
$dbh->prepare(
|
||
"insert into bibliosubtitle set biblionumber = ?, subtitle = ?");
|
||
$sth->execute( $bibnum, $subtitle ) if $subtitle;
|
||
$sth->finish;
|
||
}
|
||
|
||
sub OLDnewitems {
|
||
my ( $dbh, $item, $barcode ) = @_;
|
||
|
||
# warn "OLDNEWITEMS";
|
||
|
||
$dbh->do('lock tables items WRITE, biblio WRITE,biblioitems WRITE');
|
||
my $sth = $dbh->prepare("Select max(itemnumber) from items");
|
||
my $data;
|
||
my $itemnumber;
|
||
my $error = "";
|
||
$sth->execute;
|
||
$data = $sth->fetchrow_hashref;
|
||
$itemnumber = $data->{'max(itemnumber)'} + 1;
|
||
|
||
# FIXME the "notforloan" field seems to be named "loan" in some places. workaround bugfix.
|
||
if ( $item->{'loan'} ) {
|
||
$item->{'notforloan'} = $item->{'loan'};
|
||
}
|
||
|
||
# if dateaccessioned is provided, use it. Otherwise, set to NOW()
|
||
if ( $item->{'dateaccessioned'} ) {
|
||
$sth = $dbh->prepare( "Insert into items set
|
||
itemnumber = ?, biblionumber = ?,
|
||
multivolumepart = ?,
|
||
biblioitemnumber = ?, barcode = ?,
|
||
booksellerid = ?, dateaccessioned = ?,
|
||
homebranch = ?, holdingbranch = ?,
|
||
price = ?, replacementprice = ?,
|
||
replacementpricedate = NOW(), datelastseen = NOW(),
|
||
multivolume = ?, stack = ?,
|
||
itemlost = ?, wthdrawn = ?,
|
||
paidfor = ?, itemnotes = ?,
|
||
itemcallnumber =?, notforloan = ?,
|
||
location = ?
|
||
"
|
||
);
|
||
$sth->execute(
|
||
$itemnumber, $item->{'biblionumber'},
|
||
$item->{'multivolumepart'},
|
||
$item->{'biblioitemnumber'},$barcode,
|
||
$item->{'booksellerid'}, $item->{'dateaccessioned'},
|
||
$item->{'homebranch'}, $item->{'holdingbranch'},
|
||
$item->{'price'}, $item->{'replacementprice'},
|
||
$item->{multivolume}, $item->{stack},
|
||
$item->{itemlost}, $item->{wthdrawn},
|
||
$item->{paidfor}, $item->{'itemnotes'},
|
||
$item->{'itemcallnumber'}, $item->{'notforloan'},
|
||
$item->{'location'}
|
||
);
|
||
if ( defined $sth->errstr ) {
|
||
$error .= $sth->errstr;
|
||
}
|
||
}
|
||
else {
|
||
$sth = $dbh->prepare( "Insert into items set
|
||
itemnumber = ?, biblionumber = ?,
|
||
multivolumepart = ?,
|
||
biblioitemnumber = ?, barcode = ?,
|
||
booksellerid = ?, dateaccessioned = NOW(),
|
||
homebranch = ?, holdingbranch = ?,
|
||
price = ?, replacementprice = ?,
|
||
replacementpricedate = NOW(), datelastseen = NOW(),
|
||
multivolume = ?, stack = ?,
|
||
itemlost = ?, wthdrawn = ?,
|
||
paidfor = ?, itemnotes = ?,
|
||
itemcallnumber =?, notforloan = ?,
|
||
location = ?
|
||
"
|
||
);
|
||
$sth->execute(
|
||
$itemnumber, $item->{'biblionumber'},
|
||
$item->{'multivolumepart'},
|
||
$item->{'biblioitemnumber'},$barcode,
|
||
$item->{'booksellerid'},
|
||
$item->{'homebranch'}, $item->{'holdingbranch'},
|
||
$item->{'price'}, $item->{'replacementprice'},
|
||
$item->{multivolume}, $item->{stack},
|
||
$item->{itemlost}, $item->{wthdrawn},
|
||
$item->{paidfor}, $item->{'itemnotes'},
|
||
$item->{'itemcallnumber'}, $item->{'notforloan'},
|
||
$item->{'location'}
|
||
);
|
||
if ( defined $sth->errstr ) {
|
||
$error .= $sth->errstr;
|
||
}
|
||
}
|
||
# item stored, now, deal with the marc part...
|
||
$sth = $dbh->prepare("select biblioitems.marc,biblio.frameworkcode from biblioitems,biblio
|
||
where biblio.biblionumber=biblioitems.biblionumber and
|
||
biblio.biblionumber=?");
|
||
$sth->execute($item->{biblionumber});
|
||
if ( defined $sth->errstr ) {
|
||
$error .= $sth->errstr;
|
||
}
|
||
my ($rawmarc,$frameworkcode) = $sth->fetchrow;
|
||
warn "ERROR IN OLDnewitem, MARC record not found FOR $item->{biblionumber} => $rawmarc <=" unless $rawmarc;
|
||
my $record = MARC::File::USMARC::decode($rawmarc);
|
||
# ok, we have the marc record, add item number to the item field (in {marc}, and add the field to the record)
|
||
my ($itemnumberfield,$itemnumbersubfield) = MARCfind_marc_from_kohafield($dbh,'items.itemnumber',$frameworkcode);
|
||
my $itemrecord = MARC::File::USMARC::decode($item->{marc});
|
||
my $itemfield = $itemrecord->field($itemnumberfield);
|
||
$itemfield->add_subfields($itemnumbersubfield => "$itemnumber");
|
||
$record->insert_grouped_field($itemfield);
|
||
# save the record into biblioitem
|
||
$sth=$dbh->prepare("update biblioitems set marc=?,marcxml=? where biblionumber=?");
|
||
$sth->execute($record->as_usmarc(),$record->as_xml(),$item->{biblionumber});
|
||
if ( defined $sth->errstr ) {
|
||
$error .= $sth->errstr;
|
||
}
|
||
$dbh->do('unlock tables');
|
||
return ( $itemnumber, $error );
|
||
}
|
||
|
||
sub OLDmoditem {
|
||
my ( $dbh, $item ) = @_;
|
||
my $error;
|
||
$dbh->do('lock tables items WRITE, biblio WRITE,biblioitems WRITE');
|
||
$item->{'itemnum'} = $item->{'itemnumber'} unless $item->{'itemnum'};
|
||
my $query = "update items set barcode=?,itemnotes=?,itemcallnumber=?,notforloan=?,location=?,multivolumepart=?,multivolume=?,stack=?,wthdrawn=?";
|
||
my @bind = (
|
||
$item->{'barcode'}, $item->{'notes'},
|
||
$item->{'itemcallnumber'}, $item->{'notforloan'},
|
||
$item->{'location'}, $item->{multivolumepart},
|
||
$item->{multivolume}, $item->{stack},
|
||
$item->{wthdrawn},
|
||
);
|
||
if ( $item->{'lost'} ne '' ) {
|
||
$query = "update items set biblioitemnumber=?,barcode=?,itemnotes=?,homebranch=?,
|
||
itemlost=?,wthdrawn=?,itemcallnumber=?,notforloan=?,
|
||
location=?,multivolumepart=?,multivolume=?,stack=?,wthdrawn=?";
|
||
@bind = (
|
||
$item->{'bibitemnum'}, $item->{'barcode'},
|
||
$item->{'notes'}, $item->{'homebranch'},
|
||
$item->{'lost'}, $item->{'wthdrawn'},
|
||
$item->{'itemcallnumber'}, $item->{'notforloan'},
|
||
$item->{'location'}, $item->{multivolumepart},
|
||
$item->{multivolume}, $item->{stack},
|
||
$item->{wthdrawn},
|
||
);
|
||
if ($item->{homebranch}) {
|
||
$query.=",homebranch=?";
|
||
push @bind, $item->{homebranch};
|
||
}
|
||
if ($item->{holdingbranch}) {
|
||
$query.=",holdingbranch=?";
|
||
push @bind, $item->{holdingbranch};
|
||
}
|
||
}
|
||
$query.=" where itemnumber=?";
|
||
push @bind,$item->{'itemnum'};
|
||
if ( $item->{'replacement'} ne '' ) {
|
||
$query =~ s/ where/,replacementprice='$item->{'replacement'}' where/;
|
||
}
|
||
my $sth = $dbh->prepare($query);
|
||
$sth->execute(@bind);
|
||
|
||
# item stored, now, deal with the marc part...
|
||
$sth = $dbh->prepare("select biblioitems.marc,biblio.frameworkcode from biblioitems,biblio
|
||
where biblio.biblionumber=biblioitems.biblionumber and
|
||
biblio.biblionumber=? and
|
||
biblioitems.biblioitemnumber=?");
|
||
$sth->execute($item->{biblionumber},$item->{biblioitemnumber});
|
||
if ( defined $sth->errstr ) {
|
||
$error .= $sth->errstr;
|
||
}
|
||
my ($rawmarc,$frameworkcode) = $sth->fetchrow;
|
||
warn "ERROR IN OLDmoditem, MARC record not found" unless $rawmarc;
|
||
my $record = MARC::File::USMARC::decode($rawmarc);
|
||
# ok, we have the marc record, find the previous item record for this itemnumber and delete it
|
||
my ($itemnumberfield,$itemnumbersubfield) = MARCfind_marc_from_kohafield($dbh,'items.itemnumber',$frameworkcode);
|
||
# prepare the new item record
|
||
my $itemrecord = MARC::File::USMARC::decode($item->{marc});
|
||
my $itemfield = $itemrecord->field($itemnumberfield);
|
||
$itemfield->add_subfields($itemnumbersubfield => '$itemnumber');
|
||
# parse all fields fields from the complete record
|
||
foreach ($record->field($itemnumberfield)) {
|
||
# when the previous field is found, replace by the new one
|
||
if ($_->subfield($itemnumbersubfield) == $item->{itemnum}) {
|
||
$_->replace_with($itemfield);
|
||
}
|
||
}
|
||
# $record->insert_grouped_field($itemfield);
|
||
# save the record into biblioitem
|
||
$sth=$dbh->prepare("update biblioitems set marc=?,marcxml=? where biblionumber=? and biblioitemnumber=?");
|
||
$sth->execute($record->as_usmarc(),$record->as_xml(),$item->{biblionumber},$item->{biblioitemnumber});
|
||
if ( defined $sth->errstr ) {
|
||
$error .= $sth->errstr;
|
||
}
|
||
$dbh->do('unlock tables');
|
||
|
||
# $dbh->disconnect;
|
||
}
|
||
|
||
sub OLDdelitem {
|
||
my ( $dbh, $itemnum ) = @_;
|
||
|
||
# my $dbh=C4Connect;
|
||
my $sth = $dbh->prepare("select * from items where itemnumber=?");
|
||
$sth->execute($itemnum);
|
||
my $data = $sth->fetchrow_hashref;
|
||
$sth->finish;
|
||
my $query = "Insert into deleteditems set ";
|
||
my @bind = ();
|
||
foreach my $temp ( keys %$data ) {
|
||
$query .= "$temp = ?,";
|
||
push ( @bind, $data->{$temp} );
|
||
}
|
||
$query =~ s/\,$//;
|
||
|
||
# print $query;
|
||
$sth = $dbh->prepare($query);
|
||
$sth->execute(@bind);
|
||
$sth->finish;
|
||
$sth = $dbh->prepare("Delete from items where itemnumber=?");
|
||
$sth->execute($itemnum);
|
||
$sth->finish;
|
||
|
||
# $dbh->disconnect;
|
||
}
|
||
|
||
sub OLDdeletebiblioitem {
|
||
my ( $dbh, $biblioitemnumber ) = @_;
|
||
|
||
# my $dbh = C4Connect;
|
||
my $sth = $dbh->prepare( "Select * from biblioitems
|
||
where biblioitemnumber = ?"
|
||
);
|
||
my $results;
|
||
|
||
$sth->execute($biblioitemnumber);
|
||
|
||
if ( $results = $sth->fetchrow_hashref ) {
|
||
$sth->finish;
|
||
$sth =
|
||
$dbh->prepare(
|
||
"Insert into deletedbiblioitems (biblioitemnumber, biblionumber, volume, number, classification, itemtype,
|
||
isbn, issn ,dewey ,subclass ,publicationyear ,publishercode ,volumedate ,volumeddesc ,timestamp ,illus ,
|
||
pages ,notes ,size ,url ,lccn ) values(?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)"
|
||
);
|
||
|
||
$sth->execute(
|
||
$results->{biblioitemnumber}, $results->{biblionumber},
|
||
$results->{volume}, $results->{number},
|
||
$results->{classification}, $results->{itemtype},
|
||
$results->{isbn}, $results->{issn},
|
||
$results->{dewey}, $results->{subclass},
|
||
$results->{publicationyear}, $results->{publishercode},
|
||
$results->{volumedate}, $results->{volumeddesc},
|
||
$results->{timestamp}, $results->{illus},
|
||
$results->{pages}, $results->{notes},
|
||
$results->{size}, $results->{url},
|
||
$results->{lccn}
|
||
);
|
||
my $sth2 =
|
||
$dbh->prepare("Delete from biblioitems where biblioitemnumber = ?");
|
||
$sth2->execute($biblioitemnumber);
|
||
$sth2->finish();
|
||
} # if
|
||
$sth->finish;
|
||
|
||
# Now delete all the items attached to the biblioitem
|
||
$sth = $dbh->prepare("Select * from items where biblioitemnumber = ?");
|
||
$sth->execute($biblioitemnumber);
|
||
my @results;
|
||
while ( my $data = $sth->fetchrow_hashref ) {
|
||
my $query = "Insert into deleteditems set ";
|
||
my @bind = ();
|
||
foreach my $temp ( keys %$data ) {
|
||
$query .= "$temp = ?,";
|
||
push ( @bind, $data->{$temp} );
|
||
}
|
||
$query =~ s/\,$//;
|
||
my $sth2 = $dbh->prepare($query);
|
||
$sth2->execute(@bind);
|
||
} # while
|
||
$sth->finish;
|
||
$sth = $dbh->prepare("Delete from items where biblioitemnumber = ?");
|
||
$sth->execute($biblioitemnumber);
|
||
$sth->finish();
|
||
|
||
# $dbh->disconnect;
|
||
} # sub deletebiblioitem
|
||
|
||
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 ";
|
||
my @bind = ();
|
||
foreach my $temp ( keys %$data ) {
|
||
$query .= "$temp = ?,";
|
||
push ( @bind, $data->{$temp} );
|
||
}
|
||
|
||
#replacing the last , by ",?)"
|
||
$query =~ s/\,$//;
|
||
$sth = $dbh->prepare($query);
|
||
$sth->execute(@bind);
|
||
$sth->finish;
|
||
$sth = $dbh->prepare("Delete from biblio where biblionumber=?");
|
||
$sth->execute($biblio);
|
||
$sth->finish;
|
||
}
|
||
$sth->finish;
|
||
}
|
||
|
||
#
|
||
#
|
||
# old functions
|
||
#
|
||
#
|
||
|
||
sub itemcount {
|
||
my ($biblio) = @_;
|
||
my $dbh = C4::Context->dbh;
|
||
|
||
# print $query;
|
||
my $sth = $dbh->prepare("Select count(*) from items where biblionumber=?");
|
||
$sth->execute($biblio);
|
||
my $data = $sth->fetchrow_hashref;
|
||
$sth->finish;
|
||
return ( $data->{'count(*)'} );
|
||
}
|
||
|
||
sub newbiblio {
|
||
my ($biblio) = @_;
|
||
my $dbh = C4::Context->dbh;
|
||
my $bibnum = OLDnewbiblio( $dbh, $biblio );
|
||
# finds new (MARC bibid
|
||
# my $bibid = &MARCfind_MARCbibid_from_oldbiblionumber($dbh,$bibnum);
|
||
my $record = &MARCkoha2marcBiblio( $dbh, $bibnum );
|
||
MARCaddbiblio( $dbh, $record, $bibnum,'' );
|
||
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);
|
||
|
||
Sets the subtitle of a book.
|
||
|
||
C<$biblionumber> is the biblionumber of the book to modify.
|
||
|
||
C<$subtitle> is the new subtitle.
|
||
|
||
=cut
|
||
|
||
sub modsubtitle {
|
||
my ( $bibnum, $subtitle ) = @_;
|
||
my $dbh = C4::Context->dbh;
|
||
&OLDmodsubtitle( $dbh, $bibnum, $subtitle );
|
||
} # sub modsubtitle
|
||
|
||
=item modaddauthor
|
||
|
||
&modaddauthor($biblionumber, $author);
|
||
|
||
Replaces all additional authors for the book with biblio number
|
||
C<$biblionumber> with C<$author>. If C<$author> is the empty string,
|
||
C<&modaddauthor> deletes all additional authors.
|
||
|
||
=cut
|
||
|
||
sub modaddauthor {
|
||
my ( $bibnum, @authors ) = @_;
|
||
my $dbh = C4::Context->dbh;
|
||
&OLDmodaddauthor( $dbh, $bibnum, @authors );
|
||
} # sub modaddauthor
|
||
|
||
=item modsubject
|
||
|
||
$error = &modsubject($biblionumber, $force, @subjects);
|
||
|
||
$force - a subject to force
|
||
|
||
$error - Error message, or undef if successful.
|
||
|
||
=cut
|
||
|
||
sub modsubject {
|
||
my ( $bibnum, $force, @subject ) = @_;
|
||
my $dbh = C4::Context->dbh;
|
||
my $error = &OLDmodsubject( $dbh, $bibnum, $force, @subject );
|
||
if ($error eq ''){
|
||
# When MARC is off, ensures that the MARC biblio table gets updated with new
|
||
# subjects, of course, it deletes the biblio in marc, and then recreates.
|
||
# This check is to ensure that no MARC data exists to lose.
|
||
if (C4::Context->preference("MARC") eq '0'){
|
||
my $MARCRecord = &MARCkoha2marcBiblio($dbh,$bibnum);
|
||
my $bibid = &MARCfind_MARCbibid_from_oldbiblionumber($dbh,$bibnum);
|
||
&MARCmodbiblio($dbh,$bibid, $MARCRecord);
|
||
}
|
||
}
|
||
return ($error);
|
||
} # sub modsubject
|
||
|
||
sub modbibitem {
|
||
my ($biblioitem) = @_;
|
||
my $dbh = C4::Context->dbh;
|
||
&OLDmodbibitem( $dbh, $biblioitem );
|
||
} # sub modbibitem
|
||
|
||
sub modnote {
|
||
my ( $bibitemnum, $note ) = @_;
|
||
my $dbh = C4::Context->dbh;
|
||
&OLDmodnote( $dbh, $bibitemnum, $note );
|
||
}
|
||
|
||
sub newbiblioitem {
|
||
my ($biblioitem) = @_;
|
||
my $dbh = C4::Context->dbh;
|
||
my $bibitemnum = &OLDnewbiblioitem( $dbh, $biblioitem );
|
||
|
||
my $MARCbiblio =
|
||
MARCkoha2marcBiblio( $dbh, 0, $bibitemnum )
|
||
; # the 0 means "do NOT retrieve biblio, only biblioitem, in the MARC record
|
||
my $bibid =
|
||
&MARCfind_MARCbibid_from_oldbiblionumber( $dbh,
|
||
$biblioitem->{biblionumber} );
|
||
&MARCaddbiblio( $dbh, $MARCbiblio, $biblioitem->{biblionumber}, '',$bibid );
|
||
return ($bibitemnum);
|
||
}
|
||
|
||
sub newsubject {
|
||
my ($bibnum) = @_;
|
||
my $dbh = C4::Context->dbh;
|
||
&OLDnewsubject( $dbh, $bibnum );
|
||
}
|
||
|
||
sub newsubtitle {
|
||
my ( $bibnum, $subtitle ) = @_;
|
||
my $dbh = C4::Context->dbh;
|
||
&OLDnewsubtitle( $dbh, $bibnum, $subtitle );
|
||
}
|
||
|
||
sub newitems {
|
||
my ( $item, @barcodes ) = @_;
|
||
my $dbh = C4::Context->dbh;
|
||
my $errors;
|
||
my $itemnumber;
|
||
my $error;
|
||
foreach my $barcode (@barcodes) {
|
||
( $itemnumber, $error ) = &OLDnewitems( $dbh, $item, uc($barcode) );
|
||
$errors .= $error;
|
||
my $MARCitem =
|
||
&MARCkoha2marcItem( $dbh, $item->{biblionumber}, $itemnumber );
|
||
&MARCadditem( $dbh, $MARCitem, $item->{biblionumber} );
|
||
}
|
||
return ($errors);
|
||
}
|
||
|
||
sub moditem {
|
||
my ($item) = @_;
|
||
my $dbh = C4::Context->dbh;
|
||
&OLDmoditem( $dbh, $item );
|
||
my $MARCitem =
|
||
&MARCkoha2marcItem( $dbh, $item->{'biblionumber'}, $item->{'itemnum'} );
|
||
my $bibid =
|
||
&MARCfind_MARCbibid_from_oldbiblionumber( $dbh, $item->{biblionumber} );
|
||
&MARCmoditem( $dbh, $MARCitem, $bibid, $item->{itemnum}, 0 );
|
||
}
|
||
|
||
sub checkitems {
|
||
my ( $count, @barcodes ) = @_;
|
||
my $dbh = C4::Context->dbh;
|
||
my $error;
|
||
my $sth = $dbh->prepare("Select * from items where barcode=?");
|
||
for ( my $i = 0 ; $i < $count ; $i++ ) {
|
||
$barcodes[$i] = uc $barcodes[$i];
|
||
$sth->execute( $barcodes[$i] );
|
||
if ( my $data = $sth->fetchrow_hashref ) {
|
||
$error .= " Duplicate Barcode: $barcodes[$i]";
|
||
}
|
||
}
|
||
$sth->finish;
|
||
return ($error);
|
||
}
|
||
|
||
sub countitems {
|
||
my ($bibitemnum) = @_;
|
||
my $dbh = C4::Context->dbh;
|
||
my $query = "";
|
||
my $sth =
|
||
$dbh->prepare("Select count(*) from items where biblioitemnumber=?");
|
||
$sth->execute($bibitemnum);
|
||
my $data = $sth->fetchrow_hashref;
|
||
$sth->finish;
|
||
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;
|
||
my $sth = $dbh->prepare("Select * from biblio where biblionumber = ?");
|
||
|
||
# || die "Cannot prepare $query\n" . $dbh->errstr;
|
||
my $count = 0;
|
||
my @results;
|
||
|
||
$sth->execute($biblionumber);
|
||
|
||
# || die "Cannot execute $query\n" . $sth->errstr;
|
||
while ( my $data = $sth->fetchrow_hashref ) {
|
||
$results[$count] = $data;
|
||
$count++;
|
||
} # while
|
||
|
||
$sth->finish;
|
||
return ( $count, @results );
|
||
} # sub getbiblio
|
||
|
||
sub getbiblioitem {
|
||
my ($biblioitemnum) = @_;
|
||
my $dbh = C4::Context->dbh;
|
||
my $sth = $dbh->prepare( "Select * from biblioitems where
|
||
biblioitemnumber = ?"
|
||
);
|
||
my $count = 0;
|
||
my @results;
|
||
|
||
$sth->execute($biblioitemnum);
|
||
|
||
while ( my $data = $sth->fetchrow_hashref ) {
|
||
$results[$count] = $data;
|
||
$count++;
|
||
} # while
|
||
|
||
$sth->finish;
|
||
return ( $count, @results );
|
||
} # sub getbiblioitem
|
||
|
||
sub getbiblioitembybiblionumber {
|
||
my ($biblionumber) = @_;
|
||
my $dbh = C4::Context->dbh;
|
||
my $sth = $dbh->prepare("Select * from biblioitems where biblionumber = ?");
|
||
my $count = 0;
|
||
my @results;
|
||
|
||
$sth->execute($biblionumber);
|
||
|
||
while ( my $data = $sth->fetchrow_hashref ) {
|
||
$results[$count] = $data;
|
||
$count++;
|
||
} # while
|
||
|
||
$sth->finish;
|
||
return ( $count, @results );
|
||
} # sub
|
||
|
||
sub getitemtypes {
|
||
my $dbh = C4::Context->dbh;
|
||
my $query = "select * from itemtypes order by description";
|
||
my $sth = $dbh->prepare($query);
|
||
|
||
# || die "Cannot prepare $query" . $dbh->errstr;
|
||
my $count = 0;
|
||
my @results;
|
||
|
||
$sth->execute;
|
||
|
||
# || die "Cannot execute $query\n" . $sth->errstr;
|
||
while ( my $data = $sth->fetchrow_hashref ) {
|
||
$results[$count] = $data;
|
||
$count++;
|
||
} # while
|
||
|
||
$sth->finish;
|
||
return ( $count, @results );
|
||
} # sub getitemtypes
|
||
|
||
sub getitemsbybiblioitem {
|
||
my ($biblioitemnum) = @_;
|
||
my $dbh = C4::Context->dbh;
|
||
my $sth = $dbh->prepare( "Select * from items, biblio where
|
||
biblio.biblionumber = items.biblionumber and biblioitemnumber
|
||
= ?"
|
||
);
|
||
|
||
# || die "Cannot prepare $query\n" . $dbh->errstr;
|
||
my $count = 0;
|
||
my @results;
|
||
|
||
$sth->execute($biblioitemnum);
|
||
|
||
# || die "Cannot execute $query\n" . $sth->errstr;
|
||
while ( my $data = $sth->fetchrow_hashref ) {
|
||
$results[$count] = $data;
|
||
$count++;
|
||
} # while
|
||
|
||
$sth->finish;
|
||
return ( $count, @results );
|
||
} # sub getitemsbybiblioitem
|
||
|
||
sub logchange {
|
||
|
||
# Subroutine to log changes to databases
|
||
# Eventually, this subroutine will be used to create a log of all changes made,
|
||
# with the possibility of "undo"ing some changes
|
||
my $database = shift;
|
||
if ( $database eq 'kohadb' ) {
|
||
my $type = shift;
|
||
my $section = shift;
|
||
my $item = shift;
|
||
my $original = shift;
|
||
my $new = shift;
|
||
|
||
# print STDERR "KOHA: $type $section $item $original $new\n";
|
||
}
|
||
elsif ( $database eq 'marc' ) {
|
||
my $type = shift;
|
||
my $Record_ID = shift;
|
||
my $tag = shift;
|
||
my $mark = shift;
|
||
my $subfield_ID = shift;
|
||
my $original = shift;
|
||
my $new = shift;
|
||
|
||
# print STDERR "MARC: $type $Record_ID $tag $mark $subfield_ID $original $new\n";
|
||
}
|
||
}
|
||
|
||
#------------------------------------------------
|
||
|
||
#---------------------------------------
|
||
# Find a biblio entry, or create a new one if it doesn't exist.
|
||
# If a "subtitle" entry is in hash, add it to subtitle table
|
||
sub getoraddbiblio {
|
||
|
||
# input params
|
||
my (
|
||
$dbh, # db handle
|
||
# FIXME - Unused argument
|
||
$biblio, # hash ref to fields
|
||
) = @_;
|
||
|
||
# return
|
||
my $biblionumber;
|
||
|
||
my $debug = 0;
|
||
my $sth;
|
||
my $error;
|
||
|
||
#-----
|
||
$dbh = C4::Context->dbh;
|
||
|
||
print "<PRE>Looking for biblio </PRE>\n" if $debug;
|
||
$sth = $dbh->prepare( "select biblionumber
|
||
from biblio
|
||
where title=? and author=?
|
||
and copyrightdate=? and seriestitle=?"
|
||
);
|
||
$sth->execute(
|
||
$biblio->{title}, $biblio->{author},
|
||
$biblio->{copyright}, $biblio->{seriestitle}
|
||
);
|
||
if ( $sth->rows ) {
|
||
($biblionumber) = $sth->fetchrow;
|
||
print "<PRE>Biblio exists with number $biblionumber</PRE>\n" if $debug;
|
||
}
|
||
else {
|
||
|
||
# Doesn't exist. Add new one.
|
||
print "<PRE>Adding biblio</PRE>\n" if $debug;
|
||
( $biblionumber, $error ) = &newbiblio($biblio);
|
||
if ($biblionumber) {
|
||
print "<PRE>Added with biblio number=$biblionumber</PRE>\n"
|
||
if $debug;
|
||
if ( $biblio->{subtitle} ) {
|
||
&newsubtitle( $biblionumber, $biblio->{subtitle} );
|
||
} # if subtitle
|
||
}
|
||
else {
|
||
print "<PRE>Couldn't add biblio: $error</PRE>\n" if $debug;
|
||
} # if added
|
||
}
|
||
|
||
return $biblionumber, $error;
|
||
|
||
} # sub getoraddbiblio
|
||
|
||
sub char_decode {
|
||
|
||
# converts ISO 5426 coded string to ISO 8859-1
|
||
# sloppy code : should be improved in next issue
|
||
my ( $string, $encoding ) = @_;
|
||
$_ = $string;
|
||
|
||
# $encoding = C4::Context->preference("marcflavour") unless $encoding;
|
||
if ( $encoding eq "UNIMARC" ) {
|
||
# s/\xe1/<2F>/gm;
|
||
s/\xe2/<2F>/gm;
|
||
s/\xe9/<2F>/gm;
|
||
s/\xec/<2F>/gm;
|
||
s/\xf1/<2F>/gm;
|
||
s/\xf3/<2F>/gm;
|
||
s/\xf9/<2F>/gm;
|
||
s/\xfb/<2F>/gm;
|
||
s/\xc1\x61/<2F>/gm;
|
||
s/\xc1\x65/<2F>/gm;
|
||
s/\xc1\x69/<2F>/gm;
|
||
s/\xc1\x6f/<2F>/gm;
|
||
s/\xc1\x75/<2F>/gm;
|
||
s/\xc1\x41/<2F>/gm;
|
||
s/\xc1\x45/<2F>/gm;
|
||
s/\xc1\x49/<2F>/gm;
|
||
s/\xc1\x4f/<2F>/gm;
|
||
s/\xc1\x55/<2F>/gm;
|
||
s/\xc2\x41/<2F>/gm;
|
||
s/\xc2\x45/<2F>/gm;
|
||
s/\xc2\x49/<2F>/gm;
|
||
s/\xc2\x4f/<2F>/gm;
|
||
s/\xc2\x55/<2F>/gm;
|
||
s/\xc2\x59/<2F>/gm;
|
||
s/\xc2\x61/<2F>/gm;
|
||
s/\xc2\x65/<2F>/gm;
|
||
s/\xc2\x69/<2F>/gm;
|
||
s/\xc2\x6f/<2F>/gm;
|
||
s/\xc2\x75/<2F>/gm;
|
||
s/\xc2\x79/<2F>/gm;
|
||
s/\xc3\x41/<2F>/gm;
|
||
s/\xc3\x45/<2F>/gm;
|
||
s/\xc3\x49/<2F>/gm;
|
||
s/\xc3\x4f/<2F>/gm;
|
||
s/\xc3\x55/<2F>/gm;
|
||
s/\xc3\x61/<2F>/gm;
|
||
s/\xc3\x65/<2F>/gm;
|
||
s/\xc3\x69/<2F>/gm;
|
||
s/\xc3\x6f/<2F>/gm;
|
||
s/\xc3\x75/<2F>/gm;
|
||
s/\xc4\x41/<2F>/gm;
|
||
s/\xc4\x4e/<2F>/gm;
|
||
s/\xc4\x4f/<2F>/gm;
|
||
s/\xc4\x61/<2F>/gm;
|
||
s/\xc4\x6e/<2F>/gm;
|
||
s/\xc4\x6f/<2F>/gm;
|
||
s/\xc8\x41/<2F>/gm;
|
||
s/\xc8\x45/<2F>/gm;
|
||
s/\xc8\x49/<2F>/gm;
|
||
s/\xc8\x61/<2F>/gm;
|
||
s/\xc8\x65/<2F>/gm;
|
||
s/\xc8\x69/<2F>/gm;
|
||
s/\xc8\x6F/<2F>/gm;
|
||
s/\xc8\x75/<2F>/gm;
|
||
s/\xc8\x76/<2F>/gm;
|
||
s/\xc9\x41/<2F>/gm;
|
||
s/\xc9\x45/<2F>/gm;
|
||
s/\xc9\x49/<2F>/gm;
|
||
s/\xc9\x4f/<2F>/gm;
|
||
s/\xc9\x55/<2F>/gm;
|
||
s/\xc9\x61/<2F>/gm;
|
||
s/\xc9\x6f/<2F>/gm;
|
||
s/\xc9\x75/<2F>/gm;
|
||
s/\xca\x41/<2F>/gm;
|
||
s/\xca\x61/<2F>/gm;
|
||
s/\xd0\x43/<2F>/gm;
|
||
s/\xd0\x63/<2F>/gm;
|
||
|
||
# this handles non-sorting blocks (if implementation requires this)
|
||
$string = nsb_clean($_);
|
||
}
|
||
elsif ( $encoding eq "USMARC" || $encoding eq "MARC21" ) {
|
||
if (/[\xc1-\xff]/) {
|
||
s/\xe1\x61/<2F>/gm;
|
||
s/\xe1\x65/<2F>/gm;
|
||
s/\xe1\x69/<2F>/gm;
|
||
s/\xe1\x6f/<2F>/gm;
|
||
s/\xe1\x75/<2F>/gm;
|
||
s/\xe1\x41/<2F>/gm;
|
||
s/\xe1\x45/<2F>/gm;
|
||
s/\xe1\x49/<2F>/gm;
|
||
s/\xe1\x4f/<2F>/gm;
|
||
s/\xe1\x55/<2F>/gm;
|
||
s/\xe2\x41/<2F>/gm;
|
||
s/\xe2\x45/<2F>/gm;
|
||
s/\xe2\x49/<2F>/gm;
|
||
s/\xe2\x4f/<2F>/gm;
|
||
s/\xe2\x55/<2F>/gm;
|
||
s/\xe2\x59/<2F>/gm;
|
||
s/\xe2\x61/<2F>/gm;
|
||
s/\xe2\x65/<2F>/gm;
|
||
s/\xe2\x69/<2F>/gm;
|
||
s/\xe2\x6f/<2F>/gm;
|
||
s/\xe2\x75/<2F>/gm;
|
||
s/\xe2\x79/<2F>/gm;
|
||
s/\xe3\x41/<2F>/gm;
|
||
s/\xe3\x45/<2F>/gm;
|
||
s/\xe3\x49/<2F>/gm;
|
||
s/\xe3\x4f/<2F>/gm;
|
||
s/\xe3\x55/<2F>/gm;
|
||
s/\xe3\x61/<2F>/gm;
|
||
s/\xe3\x65/<2F>/gm;
|
||
s/\xe3\x69/<2F>/gm;
|
||
s/\xe3\x6f/<2F>/gm;
|
||
s/\xe3\x75/<2F>/gm;
|
||
s/\xe4\x41/<2F>/gm;
|
||
s/\xe4\x4e/<2F>/gm;
|
||
s/\xe4\x4f/<2F>/gm;
|
||
s/\xe4\x61/<2F>/gm;
|
||
s/\xe4\x6e/<2F>/gm;
|
||
s/\xe4\x6f/<2F>/gm;
|
||
s/\xe8\x45/<2F>/gm;
|
||
s/\xe8\x49/<2F>/gm;
|
||
s/\xe8\x65/<2F>/gm;
|
||
s/\xe8\x69/<2F>/gm;
|
||
s/\xe8\x76/<2F>/gm;
|
||
s/\xe9\x41/<2F>/gm;
|
||
s/\xe9\x4f/<2F>/gm;
|
||
s/\xe9\x55/<2F>/gm;
|
||
s/\xe9\x61/<2F>/gm;
|
||
s/\xe9\x6f/<2F>/gm;
|
||
s/\xe9\x75/<2F>/gm;
|
||
s/\xea\x41/<2F>/gm;
|
||
s/\xea\x61/<2F>/gm;
|
||
|
||
# this handles non-sorting blocks (if implementation requires this)
|
||
$string = nsb_clean($_);
|
||
}
|
||
}
|
||
return ($string);
|
||
}
|
||
|
||
sub nsb_clean {
|
||
my $NSB = '\x88'; # NSB : begin Non Sorting Block
|
||
my $NSE = '\x89'; # NSE : Non Sorting Block end
|
||
# handles non sorting blocks
|
||
my ($string) = @_;
|
||
$_ = $string;
|
||
s/$NSB/(/gm;
|
||
s/[ ]{0,1}$NSE/) /gm;
|
||
$string = $_;
|
||
return ($string);
|
||
}
|
||
|
||
sub FindDuplicate {
|
||
my ($record)=@_;
|
||
my $dbh = C4::Context->dbh;
|
||
my $result = MARCmarc2koha($dbh,$record,'');
|
||
my $sth;
|
||
my ($biblionumber,$bibid,$title);
|
||
# search duplicate on ISBN, easy and fast...
|
||
if ($result->{isbn}) {
|
||
$sth = $dbh->prepare("select biblio.biblionumber,bibid,title from biblio,biblioitems,marc_biblio where biblio.biblionumber=biblioitems.biblionumber and marc_biblio.biblionumber=biblioitems.biblionumber and isbn=?");
|
||
$sth->execute($result->{'isbn'});
|
||
($biblionumber,$bibid,$title) = $sth->fetchrow;
|
||
return $biblionumber,$bibid,$title if ($biblionumber);
|
||
}
|
||
# a more complex search : build a request for SearchMarc::catalogsearch()
|
||
my (@tags, @and_or, @excluding, @operator, @value, $offset,$length);
|
||
# search on biblio.title
|
||
my ($tag,$subfield) = MARCfind_marc_from_kohafield($dbh,"biblio.title","");
|
||
if ($record->field($tag)) {
|
||
if ($record->field($tag)->subfields($subfield)) {
|
||
push @tags, "'".$tag.$subfield."'";
|
||
push @and_or, "and";
|
||
push @excluding, "";
|
||
push @operator, "contains";
|
||
push @value, $record->field($tag)->subfield($subfield);
|
||
# warn "for title, I add $tag / $subfield".$record->field($tag)->subfield($subfield);
|
||
}
|
||
}
|
||
# ... and on biblio.author
|
||
($tag,$subfield) = MARCfind_marc_from_kohafield($dbh,"biblio.author","");
|
||
if ($record->field($tag)) {
|
||
if ($record->field($tag)->subfields($subfield)) {
|
||
push @tags, "'".$tag.$subfield."'";
|
||
push @and_or, "and";
|
||
push @excluding, "";
|
||
push @operator, "contains";
|
||
push @value, $record->field($tag)->subfield($subfield);
|
||
# warn "for author, I add $tag / $subfield".$record->field($tag)->subfield($subfield);
|
||
}
|
||
}
|
||
# ... and on publicationyear.
|
||
($tag,$subfield) = MARCfind_marc_from_kohafield($dbh,"biblioitems.publicationyear","");
|
||
if ($record->field($tag)) {
|
||
if ($record->field($tag)->subfields($subfield)) {
|
||
push @tags, "'".$tag.$subfield."'";
|
||
push @and_or, "and";
|
||
push @excluding, "";
|
||
push @operator, "=";
|
||
push @value, $record->field($tag)->subfield($subfield);
|
||
# warn "for publicationyear, I add $tag / $subfield".$record->field($tag)->subfield($subfield);
|
||
}
|
||
}
|
||
# ... and on size.
|
||
($tag,$subfield) = MARCfind_marc_from_kohafield($dbh,"biblioitems.size","");
|
||
if ($record->field($tag)) {
|
||
if ($record->field($tag)->subfields($subfield)) {
|
||
push @tags, "'".$tag.$subfield."'";
|
||
push @and_or, "and";
|
||
push @excluding, "";
|
||
push @operator, "=";
|
||
push @value, $record->field($tag)->subfield($subfield);
|
||
# warn "for size, I add $tag / $subfield".$record->field($tag)->subfield($subfield);
|
||
}
|
||
}
|
||
# ... and on publisher.
|
||
($tag,$subfield) = MARCfind_marc_from_kohafield($dbh,"biblioitems.publishercode","");
|
||
if ($record->field($tag)) {
|
||
if ($record->field($tag)->subfields($subfield)) {
|
||
push @tags, "'".$tag.$subfield."'";
|
||
push @and_or, "and";
|
||
push @excluding, "";
|
||
push @operator, "=";
|
||
push @value, $record->field($tag)->subfield($subfield);
|
||
# warn "for publishercode, I add $tag / $subfield".$record->field($tag)->subfield($subfield);
|
||
}
|
||
}
|
||
# ... and on volume.
|
||
($tag,$subfield) = MARCfind_marc_from_kohafield($dbh,"biblioitems.volume","");
|
||
if ($record->field($tag)) {
|
||
if ($record->field($tag)->subfields($subfield)) {
|
||
push @tags, "'".$tag.$subfield."'";
|
||
push @and_or, "and";
|
||
push @excluding, "";
|
||
push @operator, "=";
|
||
push @value, $record->field($tag)->subfield($subfield);
|
||
# warn "for volume, I add $tag / $subfield".$record->field($tag)->subfield($subfield);
|
||
}
|
||
}
|
||
|
||
my ($finalresult,$nbresult) = C4::SearchMarc::catalogsearch($dbh,\@tags,\@and_or,\@excluding,\@operator,\@value,0,10);
|
||
# there is at least 1 result => return the 1st one
|
||
if ($nbresult) {
|
||
# warn "$nbresult => ".@$finalresult[0]->{biblionumber},@$finalresult[0]->{bibid},@$finalresult[0]->{title};
|
||
return @$finalresult[0]->{biblionumber},@$finalresult[0]->{bibid},@$finalresult[0]->{title};
|
||
}
|
||
# no result, returns nothing
|
||
return;
|
||
}
|
||
|
||
sub DisplayISBN {
|
||
my ($isbn)=@_;
|
||
my $seg1;
|
||
if(substr($isbn, 0, 1) <=7) {
|
||
$seg1 = substr($isbn, 0, 1);
|
||
} elsif(substr($isbn, 0, 2) <= 94) {
|
||
$seg1 = substr($isbn, 0, 2);
|
||
} elsif(substr($isbn, 0, 3) <= 995) {
|
||
$seg1 = substr($isbn, 0, 3);
|
||
} elsif(substr($isbn, 0, 4) <= 9989) {
|
||
$seg1 = substr($isbn, 0, 4);
|
||
} else {
|
||
$seg1 = substr($isbn, 0, 5);
|
||
}
|
||
my $x = substr($isbn, length($seg1));
|
||
my $seg2;
|
||
if(substr($x, 0, 2) <= 19) {
|
||
# if(sTmp2 < 10) sTmp2 = "0" sTmp2;
|
||
$seg2 = substr($x, 0, 2);
|
||
} elsif(substr($x, 0, 3) <= 699) {
|
||
$seg2 = substr($x, 0, 3);
|
||
} elsif(substr($x, 0, 4) <= 8399) {
|
||
$seg2 = substr($x, 0, 4);
|
||
} elsif(substr($x, 0, 5) <= 89999) {
|
||
$seg2 = substr($x, 0, 5);
|
||
} elsif(substr($x, 0, 6) <= 9499999) {
|
||
$seg2 = substr($x, 0, 6);
|
||
} else {
|
||
$seg2 = substr($x, 0, 7);
|
||
}
|
||
my $seg3=substr($x,length($seg2));
|
||
$seg3=substr($seg3,0,length($seg3)-1) ;
|
||
my $seg4 = substr($x, -1, 1);
|
||
return "$seg1-$seg2-$seg3-$seg4";
|
||
}
|
||
|
||
|
||
END { } # module clean-up code here (global destructor)
|
||
|
||
=back
|
||
|
||
=head1 AUTHOR
|
||
|
||
Koha Developement team <info@koha.org>
|
||
|
||
Paul POULAIN paul.poulain@free.fr
|
||
|
||
=cut
|
||
|
||
# $Id$
|
||
# $Log$
|
||
# Revision 1.126 2005/08/11 09:13:28 tipaul
|
||
# just removing useless subs (a lot !!!) for code cleaning
|
||
#
|
||
# Revision 1.125 2005/08/11 09:00:07 tipaul
|
||
# Ok guys, this time, it seems that item add and modif begin working as expected...
|
||
# Still a lot of bugs to fix, of course
|
||
#
|
||
# Revision 1.124 2005/08/10 10:21:15 tipaul
|
||
# continuing the road to zebra :
|
||
# - the biblio add begins to work.
|
||
# - the biblio modif begins to work.
|
||
#
|
||
# (still without doing anything on zebra)
|
||
# (no new change in updatedatabase)
|
||
#
|
||
# Revision 1.123 2005/08/09 14:10:28 tipaul
|
||
# 1st commit to go to zebra.
|
||
# don't update your cvs if you want to have a working head...
|
||
#
|
||
# this commit contains :
|
||
# * updater/updatedatabase : get rid with marc_* tables, but DON'T remove them. As a lot of things uses them, it would not be a good idea for instance to drop them. If you really want to play, you can rename them to test head without them but being still able to reintroduce them...
|
||
# * Biblio.pm : modify MARCgetbiblio to find the raw marc record in biblioitems.marc field, not from marc_subfield_table, modify MARCfindframeworkcode to find frameworkcode in biblio.frameworkcode, modify some other subs to use biblio.biblionumber & get rid of bibid.
|
||
# * other files : get rid of bibid and use biblionumber instead.
|
||
#
|
||
# What is broken :
|
||
# * does not do anything on zebra yet.
|
||
# * if you rename marc_subfield_table, you can't search anymore.
|
||
# * you can view a biblio & bibliodetails, go to MARC editor, but NOT save any modif.
|
||
# * don't try to add a biblio, it would add data poorly... (don't try to delete either, it may work, but that would be a surprise ;-) )
|
||
#
|
||
# IMPORTANT NOTE : you need MARC::XML package (http://search.cpan.org/~esummers/MARC-XML-0.7/lib/MARC/File/XML.pm), that requires a recent version of MARC::Record
|
||
# Updatedatabase stores the iso2709 data in biblioitems.marc field & an xml version in biblioitems.marcxml Not sure we will keep it when releasing the stable version, but I think it's a good idea to have something readable in sql, at least for development stage.
|
||
|
||
# tipaul cutted previous commit notes |