3 # Copyright 2000-2002 Katipo Communications
5 # This file is part of Koha.
7 # Koha is free software; you can redistribute it and/or modify it under the
8 # terms of the GNU General Public License as published by the Free Software
9 # Foundation; either version 2 of the License, or (at your option) any later
12 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
13 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
14 # A PARTICULAR PURPOSE. See the GNU General Public License for more details.
16 # You should have received a copy of the GNU General Public License along with
17 # Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
18 # Suite 330, Boston, MA 02111-1307 USA
25 use MARC::File::USMARC;
28 use vars qw($VERSION @ISA @EXPORT);
30 # set the version for version checking
36 # don't forget MARCxxx subs are exported only for testing purposes. Should not be used
37 # as the old-style API and the NEW one are the only public functions.
40 &itemcount &newbiblio &newbiblioitem
41 &newsubject &newsubtitle
42 &modbiblio &checkitems
44 &modsubtitle &modsubject &modaddauthor &moditem
45 &delitem &deletebiblioitem &delbiblio
47 &getbiblioitembybiblionumber
48 &getbiblioitem &getitemsbybiblioitem
50 &MARCfind_marc_from_kohafield
51 &MARCfind_frameworkcode
52 &find_biblioitemnumber
55 &NEWnewbiblio &NEWnewitem
56 &NEWmodbiblio &NEWmoditem
57 &NEWdelbiblio &NEWdelitem
58 &NEWmodbiblioframework
60 &MARCkoha2marcBiblio &MARCmarc2koha
61 &MARCkoha2marcItem &MARChtml2marc
62 &MARCgetbiblio &MARCgetitem
71 C4::Biblio - acquisition, catalog management functions
75 ( lot of changes for Koha 3.0)
77 Koha 1.2 and previous version used a specific API to manage biblios. This API uses old-DB style parameters.
78 They are based on a hash, and store data in biblio/biblioitems/items tables (plus additionalauthors, bibliosubject and bibliosubtitle where applicable)
80 In Koha 2.0, we introduced a MARC-DB.
82 In Koha 3.0 we removed this MARC-DB for search as we wanted to use Zebra as search system.
84 So in Koha 3.0, saving a record means :
85 - storing the raw marc record (iso2709) in biblioitems.marc field. It contains both biblio & items informations.
86 - storing the "decoded information" in biblio/biblioitems/items as previously.
87 - using zebra to manage search & indexing on the MARC datas.
89 In Koha, there is a systempreference saying "MARC=ON" or "MARC=OFF"
91 * MARC=ON : when MARC=ON, koha uses a MARC::Record object (in sub parameters). Saving informations in the DB means :
92 - transform the MARC record into a hash
93 - add the raw marc record into the hash
94 - store them & update zebra
96 * MARC=OFF : when MARC=OFF, koha uses a hash object (in sub parameters). Saving informations in the DB means :
97 - transform the hash into a MARC record
98 - add the raw marc record into the hash
99 - store them and update zebra
102 That's why we need 3 types of subs :
106 all I<subs beginning by REAL> does effective storage of information (with a hash, one field of the hash being the raw marc record). Those subs also update the record in zebra. REAL subs should be only for internal use (called by NEW or "something else" subs
108 =head2 NEWxxx related subs
112 all I<subs beginning by NEW> use MARC::Record as parameters. it's the API that MUST be used in MARC acquisition system. They just create the hash, add it the raw marc record. Then, they call REALxxx sub.
114 all subs requires/use $dbh as 1st parameter and a MARC::Record object as 2nd parameter. they sometimes requires another parameter.
118 =head2 something_elsexxx related subs
122 all I<subs beginning by seomething else> are the old-style API. They use a hash as parameter, transform the hash into a -small- marc record, and calls REAL subs.
124 all subs requires/use $dbh as 1st parameter and a hash as 2nd parameter.
133 my ($biblionumber,$record) = @_;
134 # create the iso2709 file for zebra
135 my $cgidir = C4::Context->intranetdir ."/cgi-bin";
136 unless (opendir(DIR, "$cgidir")) {
137 $cgidir = C4::Context->intranetdir."/";
140 my $filename = $cgidir."/zebra/biblios/BIBLIO".$biblionumber."iso2709";
141 open F,"> $filename";
142 print F $record->as_usmarc();
144 my $res = system("cd $cgidir/zebra;/usr/local/bin/zebraidx update biblios");
146 warn "$biblionumber : $res";
149 =head2 @tagslib = &MARCgettagslib($dbh,1|0,$frameworkcode);
153 2nd param is 1 for liblibrarian and 0 for libopac
154 $frameworkcode contains the framework reference. If empty or does not exist, the default one is used
156 returns a hash with all values for all fields and subfields for a given MARC framework :
157 $res->{$tag}->{lib} = ($forlibrarian or !$libopac)?$liblibrarian:$libopac;
159 ->{mandatory} = $mandatory;
160 ->{repeatable} = $repeatable;
161 ->{$subfield}->{lib} = ($forlibrarian or !$libopac)?$liblibrarian:$libopac;
163 ->{mandatory} = $mandatory;
164 ->{repeatable} = $repeatable;
165 ->{authorised_value} = $authorised_value;
166 ->{authtypecode} = $authtypecode;
167 ->{value_builder} = $value_builder;
168 ->{kohafield} = $kohafield;
169 ->{seealso} = $seealso;
170 ->{hidden} = $hidden;
179 my ( $dbh, $forlibrarian, $frameworkcode ) = @_;
180 $frameworkcode = "" unless $frameworkcode;
182 my $libfield = ( $forlibrarian eq 1 ) ? 'liblibrarian' : 'libopac';
184 # check that framework exists
187 "select count(*) from marc_tag_structure where frameworkcode=?");
188 $sth->execute($frameworkcode);
189 my ($total) = $sth->fetchrow;
190 $frameworkcode = "" unless ( $total > 0 );
193 "select tagfield,liblibrarian,libopac,mandatory,repeatable from marc_tag_structure where frameworkcode=? order by tagfield"
195 $sth->execute($frameworkcode);
196 my ( $liblibrarian, $libopac, $tag, $res, $tab, $mandatory, $repeatable );
198 while ( ( $tag, $liblibrarian, $libopac, $mandatory, $repeatable ) = $sth->fetchrow ) {
199 $res->{$tag}->{lib} = ($forlibrarian or !$libopac)?$liblibrarian:$libopac;
200 $res->{$tab}->{tab} = ""; # XXX
201 $res->{$tag}->{mandatory} = $mandatory;
202 $res->{$tag}->{repeatable} = $repeatable;
207 "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"
209 $sth->execute($frameworkcode);
212 my $authorised_value;
222 ( $tag, $subfield, $liblibrarian, , $libopac, $tab,
223 $mandatory, $repeatable, $authorised_value, $authtypecode,
224 $value_builder, $kohafield, $seealso, $hidden,
229 $res->{$tag}->{$subfield}->{lib} = ($forlibrarian or !$libopac)?$liblibrarian:$libopac;
230 $res->{$tag}->{$subfield}->{tab} = $tab;
231 $res->{$tag}->{$subfield}->{mandatory} = $mandatory;
232 $res->{$tag}->{$subfield}->{repeatable} = $repeatable;
233 $res->{$tag}->{$subfield}->{authorised_value} = $authorised_value;
234 $res->{$tag}->{$subfield}->{authtypecode} = $authtypecode;
235 $res->{$tag}->{$subfield}->{value_builder} = $value_builder;
236 $res->{$tag}->{$subfield}->{kohafield} = $kohafield;
237 $res->{$tag}->{$subfield}->{seealso} = $seealso;
238 $res->{$tag}->{$subfield}->{hidden} = $hidden;
239 $res->{$tag}->{$subfield}->{isurl} = $isurl;
240 $res->{$tag}->{$subfield}->{link} = $link;
245 =head2 ($tagfield,$tagsubfield) = &MARCfind_marc_from_kohafield($dbh,$kohafield);
249 finds MARC tag and subfield for a given kohafield
250 kohafield is "table.field" where table= biblio|biblioitems|items, and field a field of the previous table
256 sub MARCfind_marc_from_kohafield {
257 my ( $dbh, $kohafield,$frameworkcode ) = @_;
258 return 0, 0 unless $kohafield;
259 my $relations = C4::Context->marcfromkohafield;
260 return ($relations->{$frameworkcode}->{$kohafield}->[0],$relations->{$frameworkcode}->{$kohafield}->[1]);
263 =head2 $MARCRecord = &MARCgetbiblio($dbh,$biblionumber);
267 Returns a MARC::Record for the biblio $biblionumber.
273 # Returns MARC::Record of the biblio passed in parameter.
274 my ( $dbh, $biblionumber ) = @_;
275 my $sth = $dbh->prepare('select marc from biblioitems where biblionumber=?');
276 $sth->execute($biblionumber);
277 my ($marc) = $sth->fetchrow;
278 my $record = MARC::File::USMARC::decode($marc);
282 =head2 $MARCrecord = &MARCgetitem($dbh,$biblionumber);
286 Returns a MARC::Record with all items of biblio # $biblionumber
294 my ( $dbh, $biblionumber, $itemnumber ) = @_;
295 my $frameworkcode=MARCfind_frameworkcode($dbh,$biblionumber);
296 # get the complete MARC record
297 my $sth = $dbh->prepare("select marc from biblioitems where biblionumber=?");
298 $sth->execute($biblionumber);
299 my ($rawmarc) = $sth->fetchrow;
300 my $record = MARC::File::USMARC::decode($rawmarc);
301 # now, find the relevant itemnumber
302 my ($itemnumberfield,$itemnumbersubfield) = MARCfind_marc_from_kohafield($dbh,'items.itemnumber',$frameworkcode);
303 # prepare the new item record
304 my $itemrecord = MARC::Record->new();
305 # parse all fields fields from the complete record
306 foreach ($record->field($itemnumberfield)) {
307 # when the item field is found, save it
308 if ($_->subfield($itemnumbersubfield) == $itemnumber) {
309 $itemrecord->append_fields($_);
316 =head2 sub find_biblioitemnumber($dbh,$biblionumber);
320 Returns the 1st biblioitemnumber related to $biblionumber. When MARC=ON we should have 1 biblionumber = 1 and only 1 biblioitemnumber
321 This sub is useless when MARC=OFF
326 sub find_biblioitemnumber {
327 my ( $dbh, $biblionumber ) = @_;
328 my $sth = $dbh->prepare("select biblioitemnumber from biblioitems where biblionumber=?");
329 $sth->execute($biblionumber);
330 my ($biblioitemnumber) = $sth->fetchrow;
331 return $biblioitemnumber;
334 =head2 $frameworkcode = MARCfind_frameworkcode($dbh,$biblionumber);
338 returns the framework of a given biblio
344 sub MARCfind_frameworkcode {
345 my ( $dbh, $biblionumber ) = @_;
346 my $sth = $dbh->prepare("select frameworkcode from biblio where biblionumber=?");
347 $sth->execute($biblionumber);
348 my ($frameworkcode) = $sth->fetchrow;
349 return $frameworkcode;
352 =head2 $MARCRecord = &MARCkoha2marcBiblio($dbh,$bibliohash);
356 MARCkoha2marcBiblio is a wrapper between old-DB and MARC-DB. It returns a MARC::Record builded with old-DB biblio/biblioitem :
357 all entries of the hash are transformed into their matching MARC field/subfield.
363 sub MARCkoha2marcBiblio {
365 # this function builds partial MARC::Record from the old koha-DB fields
366 my ( $dbh, $bibliohash ) = @_;
367 # we don't have biblio entries in the hash, so we add them first
368 my $sth = $dbh->prepare("select * from biblio where biblionumber=?");
369 $sth->execute($bibliohash->{biblionumber});
370 my $biblio = $sth->fetchrow_hashref;
371 foreach (keys %$biblio) {
372 $bibliohash->{$_}=$biblio->{$_};
374 my $sth = $dbh->prepare("select tagfield,tagsubfield from marc_subfield_structure where frameworkcode=? and kohafield=?");
375 my $record = MARC::Record->new();
376 foreach ( keys %$bibliohash ) {
377 &MARCkoha2marcOnefield( $sth, $record, "biblio." . $_, $bibliohash->{$_}, '') if $bibliohash->{$_};
378 &MARCkoha2marcOnefield( $sth, $record, "biblioitems." . $_, $bibliohash->{$_}, '') if $bibliohash->{$_};
381 # other fields => additional authors, subjects, subtitles
382 my $sth2 = $dbh->prepare(" SELECT author FROM additionalauthors WHERE biblionumber=?");
383 $sth2->execute($bibliohash->{biblionumber});
384 while ( my $row = $sth2->fetchrow_hashref ) {
385 &MARCkoha2marcOnefield( $sth, $record, "additionalauthors.author", $bibliohash->{'author'},'' );
387 $sth2 = $dbh->prepare(" SELECT subject FROM bibliosubject WHERE biblionumber=?");
388 $sth2->execute($bibliohash->{biblionumber});
389 while ( my $row = $sth2->fetchrow_hashref ) {
390 &MARCkoha2marcOnefield( $sth, $record, "bibliosubject.subject", $row->{'subject'},'' );
392 $sth2 = $dbh->prepare(" SELECT subtitle FROM bibliosubtitle WHERE biblionumber=?");
393 $sth2->execute($bibliohash->{biblionumber});
394 while ( my $row = $sth2->fetchrow_hashref ) {
395 &MARCkoha2marcOnefield( $sth, $record, "bibliosubtitle.subtitle", $row->{'subtitle'},'' );
398 warn "RECORD : ".$record->as_formatted;
402 =head2 $MARCRecord = &MARCkoha2marcItem($dbh,$biblionumber,itemnumber);
404 MARCkoha2marcItem is a wrapper between old-DB and MARC-DB. It returns a MARC::Record builded with old-DB items :
405 all entries of the hash are transformed into their matching MARC field/subfield.
413 sub MARCkoha2marcItem {
415 # this function builds partial MARC::Record from the old koha-DB fields
416 my ( $dbh, $biblionumber, $itemnumber ) = @_;
418 # my $dbh=&C4Connect;
421 "select tagfield,tagsubfield from marc_subfield_structure where frameworkcode=? and kohafield=?"
423 my $record = MARC::Record->new();
425 #--- if item, then retrieve old-style koha data
426 if ( $itemnumber > 0 ) {
428 # print STDERR "prepare $biblionumber,$itemnumber\n";
431 "SELECT itemnumber,biblionumber,multivolumepart,biblioitemnumber,barcode,dateaccessioned,
432 booksellerid,homebranch,price,replacementprice,replacementpricedate,datelastborrowed,
433 datelastseen,multivolume,stack,notforloan,itemlost,wthdrawn,itemcallnumber,issues,renewals,
434 reserves,restricted,binding,itemnotes,holdingbranch,timestamp
438 $sth2->execute($itemnumber);
439 my $row = $sth2->fetchrow_hashref;
441 foreach $code ( keys %$row ) {
442 if ( $row->{$code} ) {
443 &MARCkoha2marcOnefield( $sth, $record, "items." . $code,
451 =head2 MARCkoha2marcOnefield
455 This sub is for internal use only, used by koha2marcBiblio & koha2marcItem
461 sub MARCkoha2marcOnefield {
462 my ( $sth, $record, $kohafieldname, $value,$frameworkcode ) = @_;
465 $sth->execute($frameworkcode,$kohafieldname);
466 if ( ( $tagfield, $tagsubfield ) = $sth->fetchrow ) {
467 if ( $record->field($tagfield) ) {
468 my $tag = $record->field($tagfield);
470 $tag->add_subfields( $tagsubfield, $value );
471 $record->delete_field($tag);
472 $record->add_fields($tag);
476 $record->add_fields( $tagfield, " ", " ", $tagsubfield => $value );
482 =head2 $MARCrecord = MARChtml2marc($dbh,$rtags,$rsubfields,$rvalues,%indicators);
486 transforms the parameters (coming from HTML form) into a MARC::Record
487 parameters with r are references to arrays.
489 FIXME : should be improved for 3.0, to avoid having 4 differents arrays
496 my ($dbh,$rtags,$rsubfields,$rvalues,%indicators) = @_;
498 my $record = MARC::Record->new();
499 # my %subfieldlist=();
500 my $prevvalue; # if tag <10
501 my $field; # if tag >=10
502 for (my $i=0; $i< @$rtags; $i++) {
503 next unless @$rvalues[$i];
504 # rebuild MARC::Record
505 # warn "0=>".@$rtags[$i].@$rsubfields[$i]." = ".@$rvalues[$i].": ";
506 if (@$rtags[$i] ne $prevtag) {
509 if ($prevtag ne '000') {
510 $record->add_fields((sprintf "%03s",$prevtag),$prevvalue);
512 $record->leader($prevvalue);
517 $record->add_fields($field);
520 $indicators{@$rtags[$i]}.=' ';
521 if (@$rtags[$i] <10) {
522 $prevvalue= @$rvalues[$i];
526 $field = MARC::Field->new( (sprintf "%03s",@$rtags[$i]), substr($indicators{@$rtags[$i]},0,1),substr($indicators{@$rtags[$i]},1,1), @$rsubfields[$i] => @$rvalues[$i]);
527 # warn "1=>".@$rtags[$i].@$rsubfields[$i]." = ".@$rvalues[$i].": ".$field->as_formatted;
529 $prevtag = @$rtags[$i];
531 if (@$rtags[$i] <10) {
532 $prevvalue=@$rvalues[$i];
534 if (length(@$rvalues[$i])>0) {
535 $field->add_subfields(@$rsubfields[$i] => @$rvalues[$i]);
536 # warn "2=>".@$rtags[$i].@$rsubfields[$i]." = ".@$rvalues[$i].": ".$field->as_formatted;
539 $prevtag= @$rtags[$i];
542 # the last has not been included inside the loop... do it now !
543 $record->add_fields($field) if $field;
544 # warn "HTML2MARC=".$record->as_formatted;
549 =head2 $hash = &MARCmarc2koha($dbh,$MARCRecord);
553 builds a hash with old-db datas from a MARC::Record
560 my ($dbh,$record,$frameworkcode) = @_;
561 my $sth=$dbh->prepare("select tagfield,tagsubfield from marc_subfield_structure where frameworkcode=? and kohafield=?");
563 my $sth2=$dbh->prepare("SHOW COLUMNS from biblio");
566 while (($field)=$sth2->fetchrow) {
567 $result=&MARCmarc2kohaOneField($sth,"biblio",$field,$record,$result,$frameworkcode);
569 $sth2=$dbh->prepare("SHOW COLUMNS from biblioitems");
571 while (($field)=$sth2->fetchrow) {
572 if ($field eq 'notes') { $field = 'bnotes'; }
573 $result=&MARCmarc2kohaOneField($sth,"biblioitems",$field,$record,$result,$frameworkcode);
575 $sth2=$dbh->prepare("SHOW COLUMNS from items");
577 while (($field)=$sth2->fetchrow) {
578 $result=&MARCmarc2kohaOneField($sth,"items",$field,$record,$result,$frameworkcode);
580 # additional authors : specific
581 $result = &MARCmarc2kohaOneField($sth,"bibliosubtitle","subtitle",$record,$result,$frameworkcode);
582 $result = &MARCmarc2kohaOneField($sth,"additionalauthors","additionalauthors",$record,$result,$frameworkcode);
583 # modify copyrightdate to keep only the 1st year found
584 my $temp = $result->{'copyrightdate'};
585 $temp =~ m/c(\d\d\d\d)/; # search cYYYY first
587 $result->{'copyrightdate'} = $1;
588 } else { # if no cYYYY, get the 1st date.
589 $temp =~ m/(\d\d\d\d)/;
590 $result->{'copyrightdate'} = $1;
592 # modify publicationyear to keep only the 1st year found
593 $temp = $result->{'publicationyear'};
594 $temp =~ m/c(\d\d\d\d)/; # search cYYYY first
596 $result->{'publicationyear'} = $1;
597 } else { # if no cYYYY, get the 1st date.
598 $temp =~ m/(\d\d\d\d)/;
599 $result->{'publicationyear'} = $1;
604 sub MARCmarc2kohaOneField {
606 # FIXME ? if a field has a repeatable subfield that is used in old-db, only the 1st will be retrieved...
607 my ( $sth, $kohatable, $kohafield, $record, $result,$frameworkcode ) = @_;
608 # warn "kohatable / $kohafield / $result / ";
612 ( $tagfield, $subfield ) = MARCfind_marc_from_kohafield("",$kohatable.".".$kohafield,$frameworkcode);
613 foreach my $field ( $record->field($tagfield) ) {
614 if ($field->tag()<10) {
615 if ($result->{$kohafield}) {
616 $result->{$kohafield} .= " | ".$field->data();
618 $result->{$kohafield} = $field->data();
621 if ( $field->subfields ) {
622 my @subfields = $field->subfields();
623 foreach my $subfieldcount ( 0 .. $#subfields ) {
624 if ($subfields[$subfieldcount][0] eq $subfield) {
625 if ( $result->{$kohafield} ) {
626 $result->{$kohafield} .= " | " . $subfields[$subfieldcount][1];
629 $result->{$kohafield} = $subfields[$subfieldcount][1];
636 # warn "OneField for $kohatable.$kohafield and $frameworkcode=> $tagfield, $subfield";
640 =head2 ($biblionumber,$biblioitemnumber) = NEWnewbibilio($dbh,$MARCRecord,$frameworkcode);
644 creates a biblio from a MARC::Record.
651 my ( $dbh, $record, $frameworkcode ) = @_;
653 my $biblioitemnumber;
654 my $olddata = MARCmarc2koha( $dbh, $record,$frameworkcode );
655 $olddata->{frameworkcode} = $frameworkcode;
656 $biblionumber = REALnewbiblio( $dbh, $olddata );
657 $olddata->{biblionumber} = $biblionumber;
658 # add biblionumber into the MARC record (it's the ID for zebra)
659 my ( $tagfield, $tagsubfield ) =
660 MARCfind_marc_from_kohafield( $dbh, "biblio.biblionumber",$frameworkcode );
664 $newfield = MARC::Field->new(
665 $tagfield, $biblionumber,
668 $newfield = MARC::Field->new(
669 $tagfield, '', '', "$tagsubfield" => $biblionumber,
672 # drop old field (just in case it already exist and create new one...
673 my $old_field = $record->field($tagfield);
674 $record->delete_field($old_field);
675 $record->add_fields($newfield);
677 #create the marc entry, that stores the rax marc record in Koha 3.0
678 $olddata->{marc} = $record->as_usmarc();
679 $olddata->{marcxml} = $record->as_xml();
680 # and create biblioitem, that's all folks !
681 $biblioitemnumber = REALnewbiblioitem( $dbh, $olddata );
683 # search subtiles, addiauthors and subjects
684 ( $tagfield, $tagsubfield ) =
685 MARCfind_marc_from_kohafield( $dbh, "additionalauthors.author",$frameworkcode );
686 my @addiauthfields = $record->field($tagfield);
687 foreach my $addiauthfield (@addiauthfields) {
688 my @addiauthsubfields = $addiauthfield->subfield($tagsubfield);
689 foreach my $subfieldcount ( 0 .. $#addiauthsubfields ) {
690 REALmodaddauthor( $dbh, $biblionumber,
691 $addiauthsubfields[$subfieldcount] );
694 ( $tagfield, $tagsubfield ) =
695 MARCfind_marc_from_kohafield( $dbh, "bibliosubtitle.subtitle",$frameworkcode );
696 my @subtitlefields = $record->field($tagfield);
697 foreach my $subtitlefield (@subtitlefields) {
698 my @subtitlesubfields = $subtitlefield->subfield($tagsubfield);
699 foreach my $subfieldcount ( 0 .. $#subtitlesubfields ) {
700 REALnewsubtitle( $dbh, $biblionumber,
701 $subtitlesubfields[$subfieldcount] );
704 ( $tagfield, $tagsubfield ) =
705 MARCfind_marc_from_kohafield( $dbh, "bibliosubject.subject",$frameworkcode );
706 my @subj = $record->field($tagfield);
708 foreach my $subject (@subj) {
709 my @subjsubfield = $subject->subfield($tagsubfield);
710 foreach my $subfieldcount ( 0 .. $#subjsubfield ) {
711 push @subjects, $subjsubfield[$subfieldcount];
714 REALmodsubject( $dbh, $biblionumber, 1, @subjects );
715 return ( $biblionumber, $biblioitemnumber );
718 =head2 NEWmodbilbioframework($dbh,$biblionumber,$frameworkcode);
722 modify the framework of a biblio
728 sub NEWmodbiblioframework {
729 my ($dbh,$biblionumber,$frameworkcode) =@_;
730 my $sth = $dbh->prepare("Update biblio SET frameworkcode=? WHERE biblionumber=?");
731 $sth->execute($frameworkcode,$biblionumber);
735 =head2 NEWmodbiblio($dbh,$MARCrecord,$biblionumber,$frameworkcode);
739 modify a biblio (MARC=ON)
746 my ($dbh,$record,$biblionumber,$frameworkcode) =@_;
747 $frameworkcode="" unless $frameworkcode;
748 # &MARCmodbiblio($dbh,$bibid,$record,$frameworkcode,0);
749 my $oldbiblio = MARCmarc2koha($dbh,$record,$frameworkcode);
751 $oldbiblio->{frameworkcode} = $frameworkcode;
752 #create the marc entry, that stores the rax marc record in Koha 3.0
753 $oldbiblio->{marc} = $record->as_usmarc();
754 $oldbiblio->{marcxml} = $record->as_xml();
756 REALmodbiblio($dbh,$oldbiblio);
757 REALmodbiblioitem($dbh,$oldbiblio);
758 # now, modify addi authors, subject, addititles.
759 my ($tagfield,$tagsubfield) = MARCfind_marc_from_kohafield($dbh,"additionalauthors.author",$frameworkcode);
760 my @addiauthfields = $record->field($tagfield);
761 foreach my $addiauthfield (@addiauthfields) {
762 my @addiauthsubfields = $addiauthfield->subfield($tagsubfield);
763 foreach my $subfieldcount (0..$#addiauthsubfields) {
764 REALmodaddauthor($dbh,$biblionumber,$addiauthsubfields[$subfieldcount]);
767 ($tagfield,$tagsubfield) = MARCfind_marc_from_kohafield($dbh,"bibliosubtitle.subtitle",$frameworkcode);
768 my @subtitlefields = $record->field($tagfield);
769 foreach my $subtitlefield (@subtitlefields) {
770 my @subtitlesubfields = $subtitlefield->subfield($tagsubfield);
771 # delete & create subtitle again because REALmodsubtitle can't handle new subtitles
773 $dbh->do("delete from bibliosubtitle where biblionumber=$biblionumber");
774 foreach my $subfieldcount (0..$#subtitlesubfields) {
775 foreach my $subtit(split /\||#/,$subtitlesubfields[$subfieldcount]) {
776 REALnewsubtitle($dbh,$biblionumber,$subtit);
780 ($tagfield,$tagsubfield) = MARCfind_marc_from_kohafield($dbh,"bibliosubject.subject",$frameworkcode);
781 my @subj = $record->field($tagfield);
783 foreach my $subject (@subj) {
784 my @subjsubfield = $subject->subfield($tagsubfield);
785 foreach my $subfieldcount (0..$#subjsubfield) {
786 push @subjects,$subjsubfield[$subfieldcount];
789 REALmodsubject($dbh,$biblionumber,1,@subjects);
793 =head2 NEWmodbilbioframework($dbh,$biblionumber,$frameworkcode);
804 my ( $dbh, $bibid ) = @_;
805 my $biblio = &MARCfind_oldbiblionumber_from_MARCbibid( $dbh, $bibid );
806 &REALdelbiblio( $dbh, $biblio );
809 "select biblioitemnumber from biblioitems where biblionumber=?");
810 $sth->execute($biblio);
811 while ( my ($biblioitemnumber) = $sth->fetchrow ) {
812 REALdelbiblioitem( $dbh, $biblioitemnumber );
814 &MARCdelbiblio( $dbh, $bibid, 0 );
817 =head2 $itemnumber = NEWnewitem($dbh, $record, $biblionumber, $biblioitemnumber);
821 creates an item from a MARC::Record
828 my ( $dbh, $record, $biblionumber, $biblioitemnumber ) = @_;
831 my $frameworkcode=MARCfind_frameworkcode($dbh,$biblionumber);
832 my $item = &MARCmarc2koha( $dbh, $record,$frameworkcode );
833 # needs old biblionumber and biblioitemnumber
834 $item->{'biblionumber'} = $biblionumber;
835 $item->{'biblioitemnumber'}=$biblioitemnumber;
836 $item->{marc} = $record->as_usmarc();
837 my ( $itemnumber, $error ) = &REALnewitems( $dbh, $item, $item->{barcode} );
842 =head2 $itemnumber = NEWmoditem($dbh, $record, $biblionumber, $biblioitemnumber,$itemnumber);
853 my ( $dbh, $record, $biblionumber, $biblioitemnumber, $itemnumber) = @_;
855 my $frameworkcode=MARCfind_frameworkcode($dbh,$biblionumber);
856 my $olditem = MARCmarc2koha( $dbh, $record,$frameworkcode );
858 $olditem->{marc} = $record->as_usmarc();
859 $olditem->{biblionumber} = $biblionumber;
860 $olditem->{biblioitemnumber} = $biblioitemnumber;
862 REALmoditem( $dbh, $olditem );
866 =head2 $itemnumber = NEWdelitem($dbh, $biblionumber, $biblioitemnumber, $itemnumber);
877 my ( $dbh, $bibid, $itemnumber ) = @_;
878 my $biblio = &MARCfind_oldbiblionumber_from_MARCbibid( $dbh, $bibid );
879 &REALdelitem( $dbh, $itemnumber );
880 &MARCdelitem( $dbh, $bibid, $itemnumber );
884 =head2 $biblionumber = REALnewbiblio($dbh,$biblio);
888 adds a record in biblio table. Datas are in the hash $biblio.
895 my ( $dbh, $biblio ) = @_;
897 $dbh->do('lock tables biblio WRITE');
898 my $sth = $dbh->prepare("Select max(biblionumber) from biblio");
900 my $data = $sth->fetchrow_arrayref;
901 my $bibnum = $$data[0] + 1;
904 if ( $biblio->{'seriestitle'} ) { $series = 1 }
907 $dbh->prepare("insert into biblio set biblionumber=?, title=?, author=?, copyrightdate=?,
908 serial=?, seriestitle=?, notes=?, abstract=?,
912 $bibnum, $biblio->{'title'},
913 $biblio->{'author'}, $biblio->{'copyrightdate'},
914 $biblio->{'serial'}, $biblio->{'seriestitle'},
915 $biblio->{'notes'}, $biblio->{'abstract'},
916 $biblio->{'unititle'}
920 $dbh->do('unlock tables');
924 =head2 $biblionumber = REALmodbiblio($dbh,$biblio);
928 modify a record in biblio table. Datas are in the hash $biblio.
935 my ( $dbh, $biblio ) = @_;
936 my $sth = $dbh->prepare("Update biblio set title=?, author=?, abstract=?, copyrightdate=?,
937 seriestitle=?, serial=?, unititle=?, notes=?, frameworkcode=?
938 where biblionumber = ?"
941 $biblio->{'title'}, $biblio->{'author'},
942 $biblio->{'abstract'}, $biblio->{'copyrightdate'},
943 $biblio->{'seriestitle'}, $biblio->{'serial'},
944 $biblio->{'unititle'}, $biblio->{'notes'},
945 $biblio->{frameworkcode},
946 $biblio->{'biblionumber'}
949 return ( $biblio->{'biblionumber'} );
952 =head2 REALmodsubtitle($dbh,$bibnum,$subtitle);
956 modify subtitles in bibliosubtitle table.
962 sub REALmodsubtitle {
963 my ( $dbh, $bibnum, $subtitle ) = @_;
966 "update bibliosubtitle set subtitle = ? where biblionumber = ?");
967 $sth->execute( $subtitle, $bibnum );
971 =head2 REALmodaddauthor($dbh,$bibnum,$author);
975 adds or modify additional authors
976 NOTE : Strange sub : seems to delete MANY and add only ONE author... maybe buggy ?
982 sub REALmodaddauthor {
983 my ( $dbh, $bibnum, @authors ) = @_;
985 # my $dbh = C4Connect;
987 $dbh->prepare("Delete from additionalauthors where biblionumber = ?");
989 $sth->execute($bibnum);
991 foreach my $author (@authors) {
992 if ( $author ne '' ) {
995 "Insert into additionalauthors set author = ?, biblionumber = ?"
998 $sth->execute( $author, $bibnum );
1003 } # sub modaddauthor
1005 =head2 $errors = REALmodsubject($dbh,$bibnum, $force, @subject);
1009 modify/adds subjects
1014 sub REALmodsubject {
1015 my ( $dbh, $bibnum, $force, @subject ) = @_;
1017 # my $dbh = C4Connect;
1018 my $count = @subject;
1020 for ( my $i = 0 ; $i < $count ; $i++ ) {
1021 $subject[$i] =~ s/^ //g;
1022 $subject[$i] =~ s/ $//g;
1025 "select * from catalogueentry where entrytype = 's' and catalogueentry = ?"
1027 $sth->execute( $subject[$i] );
1029 if ( my $data = $sth->fetchrow_hashref ) {
1032 if ( $force eq $subject[$i] || $force == 1 ) {
1034 # subject not in aut, chosen to force anway
1035 # so insert into cataloguentry so its in auth file
1038 "Insert into catalogueentry (entrytype,catalogueentry) values ('s',?)"
1041 $sth2->execute( $subject[$i] ) if ( $subject[$i] );
1046 "$subject[$i]\n does not exist in the subject authority file";
1049 "Select * from catalogueentry where entrytype = 's' and (catalogueentry like ? or catalogueentry like ? or catalogueentry like ?)"
1051 $sth2->execute( "$subject[$i] %", "% $subject[$i] %",
1053 while ( my $data = $sth2->fetchrow_hashref ) {
1054 $error .= "<br>$data->{'catalogueentry'}";
1061 if ( $error eq '' ) {
1063 $dbh->prepare("Delete from bibliosubject where biblionumber = ?");
1064 $sth->execute($bibnum);
1068 "Insert into bibliosubject (subject,biblionumber) values (?,?)");
1070 foreach $query (@subject) {
1071 $sth->execute( $query, $bibnum ) if ( $query && $bibnum );
1080 =head2 REALmodbiblioitem($dbh, $biblioitem);
1089 sub REALmodbiblioitem {
1090 my ( $dbh, $biblioitem ) = @_;
1093 my $sth = $dbh->prepare("update biblioitems set itemtype=?, url=?, isbn=?, issn=?,
1094 publishercode=?, publicationyear=?, classification=?, dewey=?,
1095 subclass=?, illus=?, pages=?, volumeddesc=?,
1096 notes=?, size=?, place=?, marc=?,
1098 where biblioitemnumber=?");
1099 $sth->execute( $biblioitem->{itemtype}, $biblioitem->{url}, $biblioitem->{isbn}, $biblioitem->{issn},
1100 $biblioitem->{publishercode}, $biblioitem->{publicationyear}, $biblioitem->{classification}, $biblioitem->{dewey},
1101 $biblioitem->{subclass}, $biblioitem->{illus}, $biblioitem->{pages}, $biblioitem->{volumeddesc},
1102 $biblioitem->{bnotes}, $biblioitem->{size}, $biblioitem->{place}, $biblioitem->{marc},
1103 $biblioitem->{marcxml}, $biblioitem->{biblioitemnumber});
1104 my $record = MARC::File::USMARC::decode($biblioitem->{marc});
1105 zebra_create($biblioitem->{biblionumber}, $record);
1106 # warn "MOD : $biblioitem->{biblioitemnumber} = ".$biblioitem->{marc};
1109 =head2 REALnewbiblioitem($dbh,$biblioitem);
1113 adds a biblioitem ($biblioitem is a hash with the values)
1119 sub REALnewbiblioitem {
1120 my ( $dbh, $biblioitem ) = @_;
1122 $dbh->do("lock tables biblioitems WRITE, biblio WRITE, marc_subfield_structure READ");
1123 my $sth = $dbh->prepare("Select max(biblioitemnumber) from biblioitems");
1125 my $biblioitemnumber;
1128 $data = $sth->fetchrow_arrayref;
1129 $biblioitemnumber = $$data[0] + 1;
1131 # Insert biblioitemnumber in MARC record, we need it to manage items later...
1132 my $frameworkcode=MARCfind_frameworkcode($dbh,$biblioitem->{biblionumber});
1133 my ($biblioitemnumberfield,$biblioitemnumbersubfield) = MARCfind_marc_from_kohafield($dbh,'biblioitems.biblioitemnumber',$frameworkcode);
1134 my $record = MARC::File::USMARC::decode($biblioitem->{marc});
1135 my $field=$record->field($biblioitemnumberfield);
1136 $field->update($biblioitemnumbersubfield => "$biblioitemnumber");
1137 $biblioitem->{marc} = $record->as_usmarc();
1138 $biblioitem->{marcxml} = $record->as_xml();
1140 $sth = $dbh->prepare( "insert into biblioitems set
1141 biblioitemnumber = ?, biblionumber = ?,
1142 volume = ?, number = ?,
1143 classification = ?, itemtype = ?,
1145 issn = ?, dewey = ?,
1146 subclass = ?, publicationyear = ?,
1147 publishercode = ?, volumedate = ?,
1148 volumeddesc = ?, illus = ?,
1149 pages = ?, notes = ?,
1151 marc = ?, place = ?,
1155 $biblioitemnumber, $biblioitem->{'biblionumber'},
1156 $biblioitem->{'volume'}, $biblioitem->{'number'},
1157 $biblioitem->{'classification'}, $biblioitem->{'itemtype'},
1158 $biblioitem->{'url'}, $biblioitem->{'isbn'},
1159 $biblioitem->{'issn'}, $biblioitem->{'dewey'},
1160 $biblioitem->{'subclass'}, $biblioitem->{'publicationyear'},
1161 $biblioitem->{'publishercode'}, $biblioitem->{'volumedate'},
1162 $biblioitem->{'volumeddesc'}, $biblioitem->{'illus'},
1163 $biblioitem->{'pages'}, $biblioitem->{'bnotes'},
1164 $biblioitem->{'size'}, $biblioitem->{'lccn'},
1165 $biblioitem->{'marc'}, $biblioitem->{'place'},
1166 $biblioitem->{marcxml},
1168 $dbh->do("unlock tables");
1169 zebra_create($biblioitem->{biblionumber}, $record);
1170 return ($biblioitemnumber);
1173 =head2 REALnewsubtitle($dbh,$bibnum,$subtitle);
1177 create a new subtitle
1182 sub REALnewsubtitle {
1183 my ( $dbh, $bibnum, $subtitle ) = @_;
1186 "insert into bibliosubtitle set biblionumber = ?, subtitle = ?");
1187 $sth->execute( $bibnum, $subtitle ) if $subtitle;
1191 =head2 ($itemnumber,$errors)= REALnewitems($dbh,$item,$barcode);
1195 create a item. $item is a hash and $barcode the barcode.
1202 my ( $dbh, $item, $barcode ) = @_;
1204 # warn "OLDNEWITEMS";
1206 $dbh->do('lock tables items WRITE, biblio WRITE,biblioitems WRITE');
1207 my $sth = $dbh->prepare("Select max(itemnumber) from items");
1212 $data = $sth->fetchrow_hashref;
1213 $itemnumber = $data->{'max(itemnumber)'} + 1;
1215 # FIXME the "notforloan" field seems to be named "loan" in some places. workaround bugfix.
1216 if ( $item->{'loan'} ) {
1217 $item->{'notforloan'} = $item->{'loan'};
1220 # if dateaccessioned is provided, use it. Otherwise, set to NOW()
1221 if ( $item->{'dateaccessioned'} ) {
1222 $sth = $dbh->prepare( "Insert into items set
1223 itemnumber = ?, biblionumber = ?,
1224 multivolumepart = ?,
1225 biblioitemnumber = ?, barcode = ?,
1226 booksellerid = ?, dateaccessioned = ?,
1227 homebranch = ?, holdingbranch = ?,
1228 price = ?, replacementprice = ?,
1229 replacementpricedate = NOW(), datelastseen = NOW(),
1230 multivolume = ?, stack = ?,
1231 itemlost = ?, wthdrawn = ?,
1232 paidfor = ?, itemnotes = ?,
1233 itemcallnumber =?, notforloan = ?,
1238 $itemnumber, $item->{'biblionumber'},
1239 $item->{'multivolumepart'},
1240 $item->{'biblioitemnumber'},$barcode,
1241 $item->{'booksellerid'}, $item->{'dateaccessioned'},
1242 $item->{'homebranch'}, $item->{'holdingbranch'},
1243 $item->{'price'}, $item->{'replacementprice'},
1244 $item->{multivolume}, $item->{stack},
1245 $item->{itemlost}, $item->{wthdrawn},
1246 $item->{paidfor}, $item->{'itemnotes'},
1247 $item->{'itemcallnumber'}, $item->{'notforloan'},
1250 if ( defined $sth->errstr ) {
1251 $error .= $sth->errstr;
1255 $sth = $dbh->prepare( "Insert into items set
1256 itemnumber = ?, biblionumber = ?,
1257 multivolumepart = ?,
1258 biblioitemnumber = ?, barcode = ?,
1259 booksellerid = ?, dateaccessioned = NOW(),
1260 homebranch = ?, holdingbranch = ?,
1261 price = ?, replacementprice = ?,
1262 replacementpricedate = NOW(), datelastseen = NOW(),
1263 multivolume = ?, stack = ?,
1264 itemlost = ?, wthdrawn = ?,
1265 paidfor = ?, itemnotes = ?,
1266 itemcallnumber =?, notforloan = ?,
1271 $itemnumber, $item->{'biblionumber'},
1272 $item->{'multivolumepart'},
1273 $item->{'biblioitemnumber'},$barcode,
1274 $item->{'booksellerid'},
1275 $item->{'homebranch'}, $item->{'holdingbranch'},
1276 $item->{'price'}, $item->{'replacementprice'},
1277 $item->{multivolume}, $item->{stack},
1278 $item->{itemlost}, $item->{wthdrawn},
1279 $item->{paidfor}, $item->{'itemnotes'},
1280 $item->{'itemcallnumber'}, $item->{'notforloan'},
1283 if ( defined $sth->errstr ) {
1284 $error .= $sth->errstr;
1287 # item stored, now, deal with the marc part...
1288 $sth = $dbh->prepare("select biblioitems.marc,biblio.frameworkcode from biblioitems,biblio
1289 where biblio.biblionumber=biblioitems.biblionumber and
1290 biblio.biblionumber=?");
1291 $sth->execute($item->{biblionumber});
1292 if ( defined $sth->errstr ) {
1293 $error .= $sth->errstr;
1295 my ($rawmarc,$frameworkcode) = $sth->fetchrow;
1296 warn "ERROR IN OLDnewitem, MARC record not found FOR $item->{biblionumber} => $rawmarc <=" unless $rawmarc;
1297 my $record = MARC::File::USMARC::decode($rawmarc);
1298 # ok, we have the marc record, add item number to the item field (in {marc}, and add the field to the record)
1299 my ($itemnumberfield,$itemnumbersubfield) = MARCfind_marc_from_kohafield($dbh,'items.itemnumber',$frameworkcode);
1300 my $itemrecord = MARC::File::USMARC::decode($item->{marc});
1301 my $itemfield = $itemrecord->field($itemnumberfield);
1302 $itemfield->add_subfields($itemnumbersubfield => "$itemnumber");
1303 $record->insert_grouped_field($itemfield);
1304 # save the record into biblioitem
1305 $sth=$dbh->prepare("update biblioitems set marc=?,marcxml=? where biblionumber=?");
1306 $sth->execute($record->as_usmarc(),$record->as_xml(),$item->{biblionumber});
1307 if ( defined $sth->errstr ) {
1308 $error .= $sth->errstr;
1310 zebra_create($item->{biblionumber},$record);
1311 $dbh->do('unlock tables');
1312 return ( $itemnumber, $error );
1315 =head2 REALmoditem($dbh,$item);
1326 my ( $dbh, $item ) = @_;
1328 $dbh->do('lock tables items WRITE, biblio WRITE,biblioitems WRITE');
1329 $item->{'itemnum'} = $item->{'itemnumber'} unless $item->{'itemnum'};
1330 my $query = "update items set barcode=?,itemnotes=?,itemcallnumber=?,notforloan=?,location=?,multivolumepart=?,multivolume=?,stack=?,wthdrawn=?";
1332 $item->{'barcode'}, $item->{'notes'},
1333 $item->{'itemcallnumber'}, $item->{'notforloan'},
1334 $item->{'location'}, $item->{multivolumepart},
1335 $item->{multivolume}, $item->{stack},
1338 if ( $item->{'lost'} ne '' ) {
1339 $query = "update items set biblioitemnumber=?,barcode=?,itemnotes=?,homebranch=?,
1340 itemlost=?,wthdrawn=?,itemcallnumber=?,notforloan=?,
1341 location=?,multivolumepart=?,multivolume=?,stack=?,wthdrawn=?";
1343 $item->{'bibitemnum'}, $item->{'barcode'},
1344 $item->{'notes'}, $item->{'homebranch'},
1345 $item->{'lost'}, $item->{'wthdrawn'},
1346 $item->{'itemcallnumber'}, $item->{'notforloan'},
1347 $item->{'location'}, $item->{multivolumepart},
1348 $item->{multivolume}, $item->{stack},
1351 if ($item->{homebranch}) {
1352 $query.=",homebranch=?";
1353 push @bind, $item->{homebranch};
1355 if ($item->{holdingbranch}) {
1356 $query.=",holdingbranch=?";
1357 push @bind, $item->{holdingbranch};
1360 $query.=" where itemnumber=?";
1361 push @bind,$item->{'itemnum'};
1362 if ( $item->{'replacement'} ne '' ) {
1363 $query =~ s/ where/,replacementprice='$item->{'replacement'}' where/;
1365 my $sth = $dbh->prepare($query);
1366 $sth->execute(@bind);
1368 # item stored, now, deal with the marc part...
1369 $sth = $dbh->prepare("select biblioitems.marc,biblio.frameworkcode from biblioitems,biblio
1370 where biblio.biblionumber=biblioitems.biblionumber and
1371 biblio.biblionumber=? and
1372 biblioitems.biblioitemnumber=?");
1373 $sth->execute($item->{biblionumber},$item->{biblioitemnumber});
1374 if ( defined $sth->errstr ) {
1375 $error .= $sth->errstr;
1377 my ($rawmarc,$frameworkcode) = $sth->fetchrow;
1378 warn "ERROR IN REALmoditem, MARC record not found" unless $rawmarc;
1379 my $record = MARC::File::USMARC::decode($rawmarc);
1380 # ok, we have the marc record, find the previous item record for this itemnumber and delete it
1381 my ($itemnumberfield,$itemnumbersubfield) = MARCfind_marc_from_kohafield($dbh,'items.itemnumber',$frameworkcode);
1382 # prepare the new item record
1383 my $itemrecord = MARC::File::USMARC::decode($item->{marc});
1384 my $itemfield = $itemrecord->field($itemnumberfield);
1385 $itemfield->add_subfields($itemnumbersubfield => '$itemnumber');
1386 # parse all fields fields from the complete record
1387 foreach ($record->field($itemnumberfield)) {
1388 # when the previous field is found, replace by the new one
1389 if ($_->subfield($itemnumbersubfield) == $item->{itemnum}) {
1390 $_->replace_with($itemfield);
1393 # $record->insert_grouped_field($itemfield);
1394 # save the record into biblioitem
1395 $sth=$dbh->prepare("update biblioitems set marc=?,marcxml=? where biblionumber=? and biblioitemnumber=?");
1396 $sth->execute($record->as_usmarc(),$record->as_xml(),$item->{biblionumber},$item->{biblioitemnumber});
1397 zebra_create($item->biblionumber,$record);
1398 if ( defined $sth->errstr ) {
1399 $error .= $sth->errstr;
1401 $dbh->do('unlock tables');
1406 =head2 REALdelitem($dbh,$itemnum);
1417 my ( $dbh, $itemnum ) = @_;
1419 # my $dbh=C4Connect;
1420 my $sth = $dbh->prepare("select * from items where itemnumber=?");
1421 $sth->execute($itemnum);
1422 my $data = $sth->fetchrow_hashref;
1424 my $query = "Insert into deleteditems set ";
1426 foreach my $temp ( keys %$data ) {
1427 $query .= "$temp = ?,";
1428 push ( @bind, $data->{$temp} );
1433 $sth = $dbh->prepare($query);
1434 $sth->execute(@bind);
1436 $sth = $dbh->prepare("Delete from items where itemnumber=?");
1437 $sth->execute($itemnum);
1443 =head2 REALdelbiblioitem($dbh,$biblioitemnumber);
1447 deletes a biblioitem
1448 NOTE : not standard sub name. Should be REALdelbiblioitem()
1454 sub REALdelbiblioitem {
1455 my ( $dbh, $biblioitemnumber ) = @_;
1457 # my $dbh = C4Connect;
1458 my $sth = $dbh->prepare( "Select * from biblioitems
1459 where biblioitemnumber = ?"
1463 $sth->execute($biblioitemnumber);
1465 if ( $results = $sth->fetchrow_hashref ) {
1469 "Insert into deletedbiblioitems (biblioitemnumber, biblionumber, volume, number, classification, itemtype,
1470 isbn, issn ,dewey ,subclass ,publicationyear ,publishercode ,volumedate ,volumeddesc ,timestamp ,illus ,
1471 pages ,notes ,size ,url ,lccn ) values(?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)"
1475 $results->{biblioitemnumber}, $results->{biblionumber},
1476 $results->{volume}, $results->{number},
1477 $results->{classification}, $results->{itemtype},
1478 $results->{isbn}, $results->{issn},
1479 $results->{dewey}, $results->{subclass},
1480 $results->{publicationyear}, $results->{publishercode},
1481 $results->{volumedate}, $results->{volumeddesc},
1482 $results->{timestamp}, $results->{illus},
1483 $results->{pages}, $results->{notes},
1484 $results->{size}, $results->{url},
1488 $dbh->prepare("Delete from biblioitems where biblioitemnumber = ?");
1489 $sth2->execute($biblioitemnumber);
1494 # Now delete all the items attached to the biblioitem
1495 $sth = $dbh->prepare("Select * from items where biblioitemnumber = ?");
1496 $sth->execute($biblioitemnumber);
1498 while ( my $data = $sth->fetchrow_hashref ) {
1499 my $query = "Insert into deleteditems set ";
1501 foreach my $temp ( keys %$data ) {
1502 $query .= "$temp = ?,";
1503 push ( @bind, $data->{$temp} );
1506 my $sth2 = $dbh->prepare($query);
1507 $sth2->execute(@bind);
1510 $sth = $dbh->prepare("Delete from items where biblioitemnumber = ?");
1511 $sth->execute($biblioitemnumber);
1515 } # sub deletebiblioitem
1517 =head2 REALdelbiblio($dbh,$biblio);
1528 my ( $dbh, $biblio ) = @_;
1529 my $sth = $dbh->prepare("select * from biblio where biblionumber=?");
1530 $sth->execute($biblio);
1531 if ( my $data = $sth->fetchrow_hashref ) {
1533 my $query = "Insert into deletedbiblio set ";
1535 foreach my $temp ( keys %$data ) {
1536 $query .= "$temp = ?,";
1537 push ( @bind, $data->{$temp} );
1540 #replacing the last , by ",?)"
1542 $sth = $dbh->prepare($query);
1543 $sth->execute(@bind);
1545 $sth = $dbh->prepare("Delete from biblio where biblionumber=?");
1546 $sth->execute($biblio);
1552 =head2 $number = itemcount($biblio);
1556 returns the number of items attached to a biblio
1564 my $dbh = C4::Context->dbh;
1567 my $sth = $dbh->prepare("Select count(*) from items where biblionumber=?");
1568 $sth->execute($biblio);
1569 my $data = $sth->fetchrow_hashref;
1571 return ( $data->{'count(*)'} );
1574 =head2 $biblionumber = newbiblio($biblio);
1578 create a biblio. The parameter is a hash
1586 my $dbh = C4::Context->dbh;
1587 my $bibnum = REALnewbiblio( $dbh, $biblio );
1588 # finds new (MARC bibid
1589 # my $bibid = &MARCfind_MARCbibid_from_oldbiblionumber($dbh,$bibnum);
1590 # my $record = &MARCkoha2marcBiblio( $dbh, $bibnum );
1591 # MARCaddbiblio( $dbh, $record, $bibnum,'' );
1595 =head2 $biblionumber = &modbiblio($biblio);
1599 Update a biblio record.
1601 C<$biblio> is a reference-to-hash whose keys are the fields in the
1602 biblio table in the Koha database. All fields must be present, not
1603 just the ones you wish to change.
1605 C<&modbiblio> updates the record defined by
1606 C<$biblio-E<gt>{biblionumber}> with the values in C<$biblio>.
1608 C<&modbiblio> returns C<$biblio-E<gt>{biblionumber}> whether it was
1617 my $dbh = C4::Context->dbh;
1618 my $biblionumber=REALmodbiblio($dbh,$biblio);
1619 warn "in MODBIBLIO";
1620 my $record = MARCkoha2marcBiblio($dbh,$biblionumber,$biblionumber);
1621 # finds new (MARC bibid
1622 my $bibid = &MARCfind_MARCbibid_from_oldbiblionumber($dbh,$biblionumber);
1623 MARCmodbiblio($dbh,$bibid,$record,"",0);
1624 return($biblionumber);
1627 =head2 &modsubtitle($biblionumber, $subtitle);
1631 Sets the subtitle of a book.
1633 C<$biblionumber> is the biblionumber of the book to modify.
1635 C<$subtitle> is the new subtitle.
1642 my ( $bibnum, $subtitle ) = @_;
1643 my $dbh = C4::Context->dbh;
1644 &REALmodsubtitle( $dbh, $bibnum, $subtitle );
1647 =head2 &modaddauthor($biblionumber, $author);
1651 Replaces all additional authors for the book with biblio number
1652 C<$biblionumber> with C<$author>. If C<$author> is the empty string,
1653 C<&modaddauthor> deletes all additional authors.
1660 my ( $bibnum, @authors ) = @_;
1661 my $dbh = C4::Context->dbh;
1662 &REALmodaddauthor( $dbh, $bibnum, @authors );
1663 } # sub modaddauthor
1665 =head2 $error = &modsubject($biblionumber, $force, @subjects);
1669 $force - a subject to force
1670 $error - Error message, or undef if successful.
1677 my ( $bibnum, $force, @subject ) = @_;
1678 my $dbh = C4::Context->dbh;
1679 my $error = &REALmodsubject( $dbh, $bibnum, $force, @subject );
1681 # When MARC is off, ensures that the MARC biblio table gets updated with new
1682 # subjects, of course, it deletes the biblio in marc, and then recreates.
1683 # This check is to ensure that no MARC data exists to lose.
1684 # if (C4::Context->preference("MARC") eq '0'){
1685 # warn "in modSUBJECT";
1686 # my $MARCRecord = &MARCkoha2marcBiblio($dbh,$bibnum);
1687 # my $bibid = &MARCfind_MARCbibid_from_oldbiblionumber($dbh,$bibnum);
1688 # &MARCmodbiblio($dbh,$bibid, $MARCRecord);
1694 =head2 modbibitem($biblioitem);
1698 modify a biblioitem. The parameter is a hash
1705 my ($biblioitem) = @_;
1706 my $dbh = C4::Context->dbh;
1707 &REALmodbiblioitem( $dbh, $biblioitem );
1710 =head2 $biblioitemnumber = newbiblioitem($biblioitem)
1714 create a biblioitem, the parameter is a hash
1721 my ($biblioitem) = @_;
1722 my $dbh = C4::Context->dbh;
1723 # add biblio information to the hash
1724 my $MARCbiblio = MARCkoha2marcBiblio( $dbh, $biblioitem );
1725 $biblioitem->{marc} = $MARCbiblio->as_usmarc();
1726 my $bibitemnum = &REALnewbiblioitem( $dbh, $biblioitem );
1727 return ($bibitemnum);
1730 =head2 newsubtitle($biblionumber,$subtitle);
1734 insert a subtitle for $biblionumber biblio
1742 my ( $bibnum, $subtitle ) = @_;
1743 my $dbh = C4::Context->dbh;
1744 &REALnewsubtitle( $dbh, $bibnum, $subtitle );
1747 =head2 $errors = newitems($item, @barcodes);
1751 insert items ($item is a hash)
1759 my ( $item, @barcodes ) = @_;
1760 my $dbh = C4::Context->dbh;
1764 foreach my $barcode (@barcodes) {
1765 ( $itemnumber, $error ) = &REALnewitems( $dbh, $item, uc($barcode) );
1768 &MARCkoha2marcItem( $dbh, $item->{biblionumber}, $itemnumber );
1769 &MARCadditem( $dbh, $MARCitem, $item->{biblionumber} );
1774 =head2 moditem($item);
1778 modify an item ($item is a hash with all item informations)
1787 my $dbh = C4::Context->dbh;
1788 &REALmoditem( $dbh, $item );
1790 &MARCkoha2marcItem( $dbh, $item->{'biblionumber'}, $item->{'itemnum'} );
1792 &MARCfind_MARCbibid_from_oldbiblionumber( $dbh, $item->{biblionumber} );
1793 &MARCmoditem( $dbh, $MARCitem, $bibid, $item->{itemnum}, 0 );
1796 =head2 $error = checkitems($count,@barcodes);
1800 check for each @barcode entry that the barcode is not a duplicate
1807 my ( $count, @barcodes ) = @_;
1808 my $dbh = C4::Context->dbh;
1810 my $sth = $dbh->prepare("Select * from items where barcode=?");
1811 for ( my $i = 0 ; $i < $count ; $i++ ) {
1812 $barcodes[$i] = uc $barcodes[$i];
1813 $sth->execute( $barcodes[$i] );
1814 if ( my $data = $sth->fetchrow_hashref ) {
1815 $error .= " Duplicate Barcode: $barcodes[$i]";
1822 =head2 $delitem($itemnum);
1826 delete item $itemnum being the item number to delete
1834 my $dbh = C4::Context->dbh;
1835 &REALdelitem( $dbh, $itemnum );
1838 =head2 deletebiblioitem($biblioitemnumber);
1842 delete the biblioitem $biblioitemnumber
1848 sub deletebiblioitem {
1849 my ($biblioitemnumber) = @_;
1850 my $dbh = C4::Context->dbh;
1851 &REALdelbiblioitem( $dbh, $biblioitemnumber );
1852 } # sub deletebiblioitem
1854 =head2 delbiblio($biblionumber)
1858 delete biblio $biblionumber
1866 my $dbh = C4::Context->dbh;
1867 &REALdelbiblio( $dbh, $biblio );
1868 my $bibid = &MARCfind_MARCbibid_from_oldbiblionumber( $dbh, $biblio );
1869 &MARCdelbiblio( $dbh, $bibid, 0 );
1872 =head2 ($count,@results) = getbiblio($biblionumber);
1876 return an array with hash of biblios.
1878 FIXME : biblionumber being the primary key, this sub will always return only 1 result, API should be modified...
1885 my ($biblionumber) = @_;
1886 my $dbh = C4::Context->dbh;
1887 my $sth = $dbh->prepare("Select * from biblio where biblionumber = ?");
1889 # || die "Cannot prepare $query\n" . $dbh->errstr;
1893 $sth->execute($biblionumber);
1895 # || die "Cannot execute $query\n" . $sth->errstr;
1896 while ( my $data = $sth->fetchrow_hashref ) {
1897 $results[$count] = $data;
1902 return ( $count, @results );
1905 =head2 ($count,@results) = getbiblioitem($biblioitemnumber);
1909 return an array with hash of biblioitemss.
1911 FIXME : biblioitemnumber being unique, this sub will always return only 1 result, API should be modified...
1918 my ($biblioitemnum) = @_;
1919 my $dbh = C4::Context->dbh;
1920 my $sth = $dbh->prepare( "Select * from biblioitems where
1921 biblioitemnumber = ?"
1926 $sth->execute($biblioitemnum);
1928 while ( my $data = $sth->fetchrow_hashref ) {
1929 $results[$count] = $data;
1934 return ( $count, @results );
1935 } # sub getbiblioitem
1937 =head2 ($count,@results) = getbiblioitembybiblionumber($biblionumber);
1941 return an array with hash of biblioitems for the given biblionumber.
1947 sub getbiblioitembybiblionumber {
1948 my ($biblionumber) = @_;
1949 my $dbh = C4::Context->dbh;
1950 my $sth = $dbh->prepare("Select * from biblioitems where biblionumber = ?");
1954 $sth->execute($biblionumber);
1956 while ( my $data = $sth->fetchrow_hashref ) {
1957 $results[$count] = $data;
1962 return ( $count, @results );
1965 =head2 ($count,@results) = getitemsbybiblioitem($biblionumber);
1969 returns an array with hash of items
1975 sub getitemsbybiblioitem {
1976 my ($biblioitemnum) = @_;
1977 my $dbh = C4::Context->dbh;
1978 my $sth = $dbh->prepare( "Select * from items, biblio where
1979 biblio.biblionumber = items.biblionumber and biblioitemnumber
1983 # || die "Cannot prepare $query\n" . $dbh->errstr;
1987 $sth->execute($biblioitemnum);
1989 # || die "Cannot execute $query\n" . $sth->errstr;
1990 while ( my $data = $sth->fetchrow_hashref ) {
1991 $results[$count] = $data;
1996 return ( $count, @results );
1997 } # sub getitemsbybiblioitem
2001 # converts ISO 5426 coded string to ISO 8859-1
2002 # sloppy code : should be improved in next issue
2003 my ( $string, $encoding ) = @_;
2006 # $encoding = C4::Context->preference("marcflavour") unless $encoding;
2007 if ( $encoding eq "UNIMARC" ) {
2076 # this handles non-sorting blocks (if implementation requires this)
2077 $string = nsb_clean($_);
2079 elsif ( $encoding eq "USMARC" || $encoding eq "MARC21" ) {
2080 if (/[\xc1-\xff]/) {
2133 # this handles non-sorting blocks (if implementation requires this)
2134 $string = nsb_clean($_);
2141 my $NSB = '\x88'; # NSB : begin Non Sorting Block
2142 my $NSE = '\x89'; # NSE : Non Sorting Block end
2143 # handles non sorting blocks
2147 s/[ ]{0,1}$NSE/) /gm;
2154 my $dbh = C4::Context->dbh;
2155 my $result = MARCmarc2koha($dbh,$record,'');
2157 my ($biblionumber,$bibid,$title);
2158 # search duplicate on ISBN, easy and fast...
2159 if ($result->{isbn}) {
2160 $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=?");
2161 $sth->execute($result->{'isbn'});
2162 ($biblionumber,$bibid,$title) = $sth->fetchrow;
2163 return $biblionumber,$bibid,$title if ($biblionumber);
2165 # a more complex search : build a request for SearchMarc::catalogsearch()
2166 my (@tags, @and_or, @excluding, @operator, @value, $offset,$length);
2167 # search on biblio.title
2168 my ($tag,$subfield) = MARCfind_marc_from_kohafield($dbh,"biblio.title","");
2169 if ($record->field($tag)) {
2170 if ($record->field($tag)->subfields($subfield)) {
2171 push @tags, "'".$tag.$subfield."'";
2172 push @and_or, "and";
2173 push @excluding, "";
2174 push @operator, "contains";
2175 push @value, $record->field($tag)->subfield($subfield);
2176 # warn "for title, I add $tag / $subfield".$record->field($tag)->subfield($subfield);
2179 # ... and on biblio.author
2180 ($tag,$subfield) = MARCfind_marc_from_kohafield($dbh,"biblio.author","");
2181 if ($record->field($tag)) {
2182 if ($record->field($tag)->subfields($subfield)) {
2183 push @tags, "'".$tag.$subfield."'";
2184 push @and_or, "and";
2185 push @excluding, "";
2186 push @operator, "contains";
2187 push @value, $record->field($tag)->subfield($subfield);
2188 # warn "for author, I add $tag / $subfield".$record->field($tag)->subfield($subfield);
2191 # ... and on publicationyear.
2192 ($tag,$subfield) = MARCfind_marc_from_kohafield($dbh,"biblioitems.publicationyear","");
2193 if ($record->field($tag)) {
2194 if ($record->field($tag)->subfields($subfield)) {
2195 push @tags, "'".$tag.$subfield."'";
2196 push @and_or, "and";
2197 push @excluding, "";
2198 push @operator, "=";
2199 push @value, $record->field($tag)->subfield($subfield);
2200 # warn "for publicationyear, I add $tag / $subfield".$record->field($tag)->subfield($subfield);
2204 ($tag,$subfield) = MARCfind_marc_from_kohafield($dbh,"biblioitems.size","");
2205 if ($record->field($tag)) {
2206 if ($record->field($tag)->subfields($subfield)) {
2207 push @tags, "'".$tag.$subfield."'";
2208 push @and_or, "and";
2209 push @excluding, "";
2210 push @operator, "=";
2211 push @value, $record->field($tag)->subfield($subfield);
2212 # warn "for size, I add $tag / $subfield".$record->field($tag)->subfield($subfield);
2215 # ... and on publisher.
2216 ($tag,$subfield) = MARCfind_marc_from_kohafield($dbh,"biblioitems.publishercode","");
2217 if ($record->field($tag)) {
2218 if ($record->field($tag)->subfields($subfield)) {
2219 push @tags, "'".$tag.$subfield."'";
2220 push @and_or, "and";
2221 push @excluding, "";
2222 push @operator, "=";
2223 push @value, $record->field($tag)->subfield($subfield);
2224 # warn "for publishercode, I add $tag / $subfield".$record->field($tag)->subfield($subfield);
2227 # ... and on volume.
2228 ($tag,$subfield) = MARCfind_marc_from_kohafield($dbh,"biblioitems.volume","");
2229 if ($record->field($tag)) {
2230 if ($record->field($tag)->subfields($subfield)) {
2231 push @tags, "'".$tag.$subfield."'";
2232 push @and_or, "and";
2233 push @excluding, "";
2234 push @operator, "=";
2235 push @value, $record->field($tag)->subfield($subfield);
2236 # warn "for volume, I add $tag / $subfield".$record->field($tag)->subfield($subfield);
2240 my ($finalresult,$nbresult) = C4::SearchMarc::catalogsearch($dbh,\@tags,\@and_or,\@excluding,\@operator,\@value,0,10);
2241 # there is at least 1 result => return the 1st one
2243 # warn "$nbresult => ".@$finalresult[0]->{biblionumber},@$finalresult[0]->{bibid},@$finalresult[0]->{title};
2244 return @$finalresult[0]->{biblionumber},@$finalresult[0]->{bibid},@$finalresult[0]->{title};
2246 # no result, returns nothing
2253 if(substr($isbn, 0, 1) <=7) {
2254 $seg1 = substr($isbn, 0, 1);
2255 } elsif(substr($isbn, 0, 2) <= 94) {
2256 $seg1 = substr($isbn, 0, 2);
2257 } elsif(substr($isbn, 0, 3) <= 995) {
2258 $seg1 = substr($isbn, 0, 3);
2259 } elsif(substr($isbn, 0, 4) <= 9989) {
2260 $seg1 = substr($isbn, 0, 4);
2262 $seg1 = substr($isbn, 0, 5);
2264 my $x = substr($isbn, length($seg1));
2266 if(substr($x, 0, 2) <= 19) {
2267 # if(sTmp2 < 10) sTmp2 = "0" sTmp2;
2268 $seg2 = substr($x, 0, 2);
2269 } elsif(substr($x, 0, 3) <= 699) {
2270 $seg2 = substr($x, 0, 3);
2271 } elsif(substr($x, 0, 4) <= 8399) {
2272 $seg2 = substr($x, 0, 4);
2273 } elsif(substr($x, 0, 5) <= 89999) {
2274 $seg2 = substr($x, 0, 5);
2275 } elsif(substr($x, 0, 6) <= 9499999) {
2276 $seg2 = substr($x, 0, 6);
2278 $seg2 = substr($x, 0, 7);
2280 my $seg3=substr($x,length($seg2));
2281 $seg3=substr($seg3,0,length($seg3)-1) ;
2282 my $seg4 = substr($x, -1, 1);
2283 return "$seg1-$seg2-$seg3-$seg4";
2287 END { } # module clean-up code here (global destructor)
2293 Koha Developement team <info@koha.org>
2295 Paul POULAIN paul.poulain@free.fr
2301 # Revision 1.130 2005/09/02 14:34:14 tipaul
2302 # continuing the work to move to zebra. Begin of work for MARC=OFF support.
2303 # IMPORTANT NOTE : the MARCkoha2marc sub API has been modified. Instead of biblionumber & biblioitemnumber, it now gets a hash.
2304 # The sub is used only in Biblio.pm, so the API change should be harmless (except for me, but i'm aware ;-) )
2306 # Revision 1.129 2005/08/12 13:50:31 tipaul
2307 # removing useless sub declarations
2309 # Revision 1.128 2005/08/11 16:12:47 tipaul
2310 # Playing with the zebra...
2312 # * go to koha cvs home directory
2313 # * in misc/zebra there is a unimarc directory. I suggest that marc21 libraries create a marc21 directory
2314 # * put your zebra.cfg files here & create your database.
2315 # * from koha cvs home directory, ln -s misc/zebra/marc21 zebra (I mean create a symbolic link to YOUR zebra directory)
2316 # * now, everytime you add/modify a biblio/item your zebra DB is updated correctly.
2319 # * this uses a system call in perl. CPU consumming, but we are waiting for indexdata Perl/zoom
2320 # * deletion still not work
2321 # * UNIMARC zebra config files are provided in misc/zebra/unimarc directory. The most important line being :
2323 # recordId: (bib1,Local-number)
2327 # elm 090 Local-number -
2328 # elm 090/? Local-number -
2329 # elm 090/?/9 Local-number !:w
2331 # (090$9 being the field mapped to biblio.biblionumber in Koha)
2333 # Revision 1.127 2005/08/11 14:37:32 tipaul
2335 # * removing useless subs
2336 # * removing some subs that are also elsewhere
2337 # * renaming all OLDxxx subs to REALxxx subs (should not change anything, as OLDxxx, as well as REAL, are supposed to be for Biblio.pm internal use only)
2339 # Revision 1.126 2005/08/11 09:13:28 tipaul
2340 # just removing useless subs (a lot !!!) for code cleaning
2342 # Revision 1.125 2005/08/11 09:00:07 tipaul
2343 # Ok guys, this time, it seems that item add and modif begin working as expected...
2344 # Still a lot of bugs to fix, of course
2346 # Revision 1.124 2005/08/10 10:21:15 tipaul
2347 # continuing the road to zebra :
2348 # - the biblio add begins to work.
2349 # - the biblio modif begins to work.
2351 # (still without doing anything on zebra)
2352 # (no new change in updatedatabase)
2354 # Revision 1.123 2005/08/09 14:10:28 tipaul
2355 # 1st commit to go to zebra.
2356 # don't update your cvs if you want to have a working head...
2358 # this commit contains :
2359 # * 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...
2360 # * 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.
2361 # * other files : get rid of bibid and use biblionumber instead.
2364 # * does not do anything on zebra yet.
2365 # * if you rename marc_subfield_table, you can't search anymore.
2366 # * you can view a biblio & bibliodetails, go to MARC editor, but NOT save any modif.
2367 # * 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 ;-) )
2369 # 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
2370 # 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.
2372 # tipaul cutted previous commit notes