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 &updateBiblio &updateBiblioItem &updateItem
41 &itemcount &newbiblio &newbiblioitem
42 &newsubject &newsubtitle
43 &modbiblio &checkitems
45 &modsubtitle &modsubject &modaddauthor &moditem
46 &delitem &deletebiblioitem &delbiblio
48 &getbiblioitembybiblionumber
49 &getbiblioitem &getitemsbybiblioitem
51 &newcompletebiblioitem
53 &MARCfind_marc_from_kohafield
54 &MARCfind_frameworkcode
55 &find_biblioitemnumber
58 &NEWnewbiblio &NEWnewitem
59 &NEWmodbiblio &NEWmoditem
60 &NEWdelbiblio &NEWdelitem
61 &NEWmodbiblioframework
63 &MARCkoha2marcBiblio &MARCmarc2koha
64 &MARCkoha2marcItem &MARChtml2marc
65 &MARCgetbiblio &MARCgetitem
74 C4::Biblio - acquisition, catalog management functions
78 ( lot of changes for Koha 3.0)
80 Koha 1.2 and previous version used a specific API to manage biblios. This API uses old-DB style parameters.
81 They are based on a hash, and store data in biblio/biblioitems/items tables (plus additionalauthors, bibliosubject and bibliosubtitle where applicable)
83 In Koha 2.0, we introduced a MARC-DB.
85 In Koha 3.0 we removed this MARC-DB for search as we wanted to use Zebra as search system.
87 So in Koha 3.0, saving a record means :
88 - storing the raw marc record (iso2709) in biblioitems.marc field. It contains both biblio & items informations.
89 - storing the "decoded information" in biblio/biblioitems/items as previously.
90 - using zebra to manage search & indexing on the MARC datas.
92 In Koha, there is a systempreference saying "MARC=ON" or "MARC=OFF"
94 * MARC=ON : when MARC=ON, koha uses a MARC::Record object (in sub parameters). Saving informations in the DB means :
95 - transform the MARC record into a hash
96 - add the raw marc record into the hash
97 - store them & update zebra
99 * MARC=OFF : when MARC=OFF, koha uses a hash object (in sub parameters). Saving informations in the DB means :
100 - transform the hash into a MARC record
101 - add the raw marc record into the hash
102 - store them and update zebra
105 That's why we need 3 types of subs :
109 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
111 =head2 NEWxxx related subs
115 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.
117 all subs requires/use $dbh as 1st parameter and a MARC::Record object as 2nd parameter. they sometimes requires another parameter.
121 =head2 something_elsexxx related subs
125 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.
127 all subs requires/use $dbh as 1st parameter and a hash as 2nd parameter.
136 my ($biblionumber,$record) = @_;
137 # create the iso2709 file for zebra
138 my $cgidir = C4::Context->intranetdir ."/cgi-bin";
139 unless (opendir(DIR, "$cgidir")) {
140 $cgidir = C4::Context->intranetdir."/";
143 my $filename = $cgidir."/zebra/biblios/BIBLIO".$biblionumber."iso2709";
144 open F,"> $filename";
145 print F $record->as_usmarc();
147 my $res = system("cd $cgidir/zebra;/usr/local/bin/zebraidx update biblios");
149 warn "$biblionumber : $res";
152 =head2 @tagslib = &MARCgettagslib($dbh,1|0,$frameworkcode);
156 2nd param is 1 for liblibrarian and 0 for libopac
157 $frameworkcode contains the framework reference. If empty or does not exist, the default one is used
159 returns a hash with all values for all fields and subfields for a given MARC framework :
160 $res->{$tag}->{lib} = ($forlibrarian or !$libopac)?$liblibrarian:$libopac;
162 ->{mandatory} = $mandatory;
163 ->{repeatable} = $repeatable;
164 ->{$subfield}->{lib} = ($forlibrarian or !$libopac)?$liblibrarian:$libopac;
166 ->{mandatory} = $mandatory;
167 ->{repeatable} = $repeatable;
168 ->{authorised_value} = $authorised_value;
169 ->{authtypecode} = $authtypecode;
170 ->{value_builder} = $value_builder;
171 ->{kohafield} = $kohafield;
172 ->{seealso} = $seealso;
173 ->{hidden} = $hidden;
182 my ( $dbh, $forlibrarian, $frameworkcode ) = @_;
183 $frameworkcode = "" unless $frameworkcode;
185 my $libfield = ( $forlibrarian eq 1 ) ? 'liblibrarian' : 'libopac';
187 # check that framework exists
190 "select count(*) from marc_tag_structure where frameworkcode=?");
191 $sth->execute($frameworkcode);
192 my ($total) = $sth->fetchrow;
193 $frameworkcode = "" unless ( $total > 0 );
196 "select tagfield,liblibrarian,libopac,mandatory,repeatable from marc_tag_structure where frameworkcode=? order by tagfield"
198 $sth->execute($frameworkcode);
199 my ( $liblibrarian, $libopac, $tag, $res, $tab, $mandatory, $repeatable );
201 while ( ( $tag, $liblibrarian, $libopac, $mandatory, $repeatable ) = $sth->fetchrow ) {
202 $res->{$tag}->{lib} = ($forlibrarian or !$libopac)?$liblibrarian:$libopac;
203 $res->{$tab}->{tab} = ""; # XXX
204 $res->{$tag}->{mandatory} = $mandatory;
205 $res->{$tag}->{repeatable} = $repeatable;
210 "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"
212 $sth->execute($frameworkcode);
215 my $authorised_value;
225 ( $tag, $subfield, $liblibrarian, , $libopac, $tab,
226 $mandatory, $repeatable, $authorised_value, $authtypecode,
227 $value_builder, $kohafield, $seealso, $hidden,
232 $res->{$tag}->{$subfield}->{lib} = ($forlibrarian or !$libopac)?$liblibrarian:$libopac;
233 $res->{$tag}->{$subfield}->{tab} = $tab;
234 $res->{$tag}->{$subfield}->{mandatory} = $mandatory;
235 $res->{$tag}->{$subfield}->{repeatable} = $repeatable;
236 $res->{$tag}->{$subfield}->{authorised_value} = $authorised_value;
237 $res->{$tag}->{$subfield}->{authtypecode} = $authtypecode;
238 $res->{$tag}->{$subfield}->{value_builder} = $value_builder;
239 $res->{$tag}->{$subfield}->{kohafield} = $kohafield;
240 $res->{$tag}->{$subfield}->{seealso} = $seealso;
241 $res->{$tag}->{$subfield}->{hidden} = $hidden;
242 $res->{$tag}->{$subfield}->{isurl} = $isurl;
243 $res->{$tag}->{$subfield}->{link} = $link;
248 =head2 ($tagfield,$tagsubfield) = &MARCfind_marc_from_kohafield($dbh,$kohafield);
252 finds MARC tag and subfield for a given kohafield
253 kohafield is "table.field" where table= biblio|biblioitems|items, and field a field of the previous table
259 sub MARCfind_marc_from_kohafield {
260 my ( $dbh, $kohafield,$frameworkcode ) = @_;
261 return 0, 0 unless $kohafield;
262 my $relations = C4::Context->marcfromkohafield;
263 return ($relations->{$frameworkcode}->{$kohafield}->[0],$relations->{$frameworkcode}->{$kohafield}->[1]);
266 =head2 $MARCRecord = &MARCgetbiblio($dbh,$biblionumber);
270 Returns a MARC::Record for the biblio $biblionumber.
276 # Returns MARC::Record of the biblio passed in parameter.
277 my ( $dbh, $biblionumber ) = @_;
278 my $sth = $dbh->prepare('select marc from biblioitems where biblionumber=?');
279 $sth->execute($biblionumber);
280 my ($marc) = $sth->fetchrow;
281 my $record = MARC::File::USMARC::decode($marc);
285 =head2 $MARCrecord = &MARCgetitem($dbh,$biblionumber);
289 Returns a MARC::Record with all items of biblio # $biblionumber
297 my ( $dbh, $biblionumber, $itemnumber ) = @_;
298 my $frameworkcode=MARCfind_frameworkcode($dbh,$biblionumber);
299 # get the complete MARC record
300 my $sth = $dbh->prepare("select marc from biblioitems where biblionumber=?");
301 $sth->execute($biblionumber);
302 my ($rawmarc) = $sth->fetchrow;
303 my $record = MARC::File::USMARC::decode($rawmarc);
304 # now, find the relevant itemnumber
305 my ($itemnumberfield,$itemnumbersubfield) = MARCfind_marc_from_kohafield($dbh,'items.itemnumber',$frameworkcode);
306 # prepare the new item record
307 my $itemrecord = MARC::Record->new();
308 # parse all fields fields from the complete record
309 foreach ($record->field($itemnumberfield)) {
310 # when the item field is found, save it
311 if ($_->subfield($itemnumbersubfield) == $itemnumber) {
312 $itemrecord->append_fields($_);
319 =head2 sub find_biblioitemnumber($dbh,$biblionumber);
323 Returns the 1st biblioitemnumber related to $biblionumber. When MARC=ON we should have 1 biblionumber = 1 and only 1 biblioitemnumber
324 This sub is useless when MARC=OFF
329 sub find_biblioitemnumber {
330 my ( $dbh, $biblionumber ) = @_;
331 my $sth = $dbh->prepare("select biblioitemnumber from biblioitems where biblionumber=?");
332 $sth->execute($biblionumber);
333 my ($biblioitemnumber) = $sth->fetchrow;
334 return $biblioitemnumber;
337 =head2 $frameworkcode = MARCfind_frameworkcode($dbh,$biblionumber);
341 returns the framework of a given biblio
347 sub MARCfind_frameworkcode {
348 my ( $dbh, $biblionumber ) = @_;
349 my $sth = $dbh->prepare("select frameworkcode from biblio where biblionumber=?");
350 $sth->execute($biblionumber);
351 my ($frameworkcode) = $sth->fetchrow;
352 return $frameworkcode;
355 =head2 $MARCRecord = &MARCkoha2marcBiblio($dbh,$biblionumber,biblioitemnumber);
359 MARCkoha2marcBiblio is a wrapper between old-DB and MARC-DB. It returns a MARC::Record builded with old-DB biblio/biblioitem :
360 all entries of the hash are transformed into their matching MARC field/subfield.
366 sub MARCkoha2marcBiblio {
368 # this function builds partial MARC::Record from the old koha-DB fields
369 my ( $dbh, $biblionumber, $biblioitemnumber ) = @_;
372 "select tagfield,tagsubfield from marc_subfield_structure where frameworkcode=? and kohafield=?"
374 my $record = MARC::Record->new();
376 #--- if bibid, then retrieve old-style koha data
377 if ( $biblionumber > 0 ) {
380 "select biblionumber,author,title,unititle,notes,abstract,serial,seriestitle,copyrightdate,timestamp
381 from biblio where biblionumber=?"
383 $sth2->execute($biblionumber);
384 my $row = $sth2->fetchrow_hashref;
386 foreach $code ( keys %$row ) {
387 if ( $row->{$code} ) {
388 &MARCkoha2marcOnefield( $sth, $record, "biblio." . $code,
394 #--- if biblioitem, then retrieve old-style koha data
395 if ( $biblioitemnumber > 0 ) {
398 " SELECT biblioitemnumber,biblionumber,volume,number,classification,
399 itemtype,url,isbn,issn,dewey,subclass,publicationyear,publishercode,
400 volumedate,volumeddesc,timestamp,illus,pages,notes AS bnotes,size,place
402 WHERE biblioitemnumber=?
405 $sth2->execute($biblioitemnumber);
406 my $row = $sth2->fetchrow_hashref;
408 foreach $code ( keys %$row ) {
409 if ( $row->{$code} ) {
410 &MARCkoha2marcOnefield( $sth, $record, "biblioitems." . $code,
416 # other fields => additional authors, subjects, subtitles
419 " SELECT author FROM additionalauthors WHERE biblionumber=?");
420 $sth2->execute($biblionumber);
421 while ( my $row = $sth2->fetchrow_hashref ) {
422 &MARCkoha2marcOnefield( $sth, $record, "additionalauthors.author",
423 $row->{'author'},'' );
426 $dbh->prepare(" SELECT subject FROM bibliosubject WHERE biblionumber=?");
427 $sth2->execute($biblionumber);
428 while ( my $row = $sth2->fetchrow_hashref ) {
429 &MARCkoha2marcOnefield( $sth, $record, "bibliosubject.subject",
430 $row->{'subject'},'' );
434 " SELECT subtitle FROM bibliosubtitle WHERE biblionumber=?");
435 $sth2->execute($biblionumber);
436 while ( my $row = $sth2->fetchrow_hashref ) {
437 &MARCkoha2marcOnefield( $sth, $record, "bibliosubtitle.subtitle",
438 $row->{'subtitle'},'' );
443 =head2 $MARCRecord = &MARCkoha2marcItem($dbh,$biblionumber,itemnumber);
445 MARCkoha2marcItem is a wrapper between old-DB and MARC-DB. It returns a MARC::Record builded with old-DB items :
446 all entries of the hash are transformed into their matching MARC field/subfield.
454 sub MARCkoha2marcItem {
456 # this function builds partial MARC::Record from the old koha-DB fields
457 my ( $dbh, $biblionumber, $itemnumber ) = @_;
459 # my $dbh=&C4Connect;
462 "select tagfield,tagsubfield from marc_subfield_structure where frameworkcode=? and kohafield=?"
464 my $record = MARC::Record->new();
466 #--- if item, then retrieve old-style koha data
467 if ( $itemnumber > 0 ) {
469 # print STDERR "prepare $biblionumber,$itemnumber\n";
472 "SELECT itemnumber,biblionumber,multivolumepart,biblioitemnumber,barcode,dateaccessioned,
473 booksellerid,homebranch,price,replacementprice,replacementpricedate,datelastborrowed,
474 datelastseen,multivolume,stack,notforloan,itemlost,wthdrawn,itemcallnumber,issues,renewals,
475 reserves,restricted,binding,itemnotes,holdingbranch,timestamp
479 $sth2->execute($itemnumber);
480 my $row = $sth2->fetchrow_hashref;
482 foreach $code ( keys %$row ) {
483 if ( $row->{$code} ) {
484 &MARCkoha2marcOnefield( $sth, $record, "items." . $code,
492 =head2 MARCkoha2marcOnefield
496 This sub is for internal use only, used by koha2marcBiblio & koha2marcItem
502 sub MARCkoha2marcOnefield {
503 my ( $sth, $record, $kohafieldname, $value,$frameworkcode ) = @_;
506 $sth->execute($frameworkcode,$kohafieldname);
507 if ( ( $tagfield, $tagsubfield ) = $sth->fetchrow ) {
508 if ( $record->field($tagfield) ) {
509 my $tag = $record->field($tagfield);
511 $tag->add_subfields( $tagsubfield, $value );
512 $record->delete_field($tag);
513 $record->add_fields($tag);
517 $record->add_fields( $tagfield, " ", " ", $tagsubfield => $value );
523 =head2 $MARCrecord = MARChtml2marc($dbh,$rtags,$rsubfields,$rvalues,%indicators);
527 transforms the parameters (coming from HTML form) into a MARC::Record
528 parameters with r are references to arrays.
530 FIXME : should be improved for 3.0, to avoid having 4 differents arrays
537 my ($dbh,$rtags,$rsubfields,$rvalues,%indicators) = @_;
539 my $record = MARC::Record->new();
540 # my %subfieldlist=();
541 my $prevvalue; # if tag <10
542 my $field; # if tag >=10
543 for (my $i=0; $i< @$rtags; $i++) {
544 next unless @$rvalues[$i];
545 # rebuild MARC::Record
546 # warn "0=>".@$rtags[$i].@$rsubfields[$i]." = ".@$rvalues[$i].": ";
547 if (@$rtags[$i] ne $prevtag) {
550 if ($prevtag ne '000') {
551 $record->add_fields((sprintf "%03s",$prevtag),$prevvalue);
553 $record->leader($prevvalue);
558 $record->add_fields($field);
561 $indicators{@$rtags[$i]}.=' ';
562 if (@$rtags[$i] <10) {
563 $prevvalue= @$rvalues[$i];
567 $field = MARC::Field->new( (sprintf "%03s",@$rtags[$i]), substr($indicators{@$rtags[$i]},0,1),substr($indicators{@$rtags[$i]},1,1), @$rsubfields[$i] => @$rvalues[$i]);
568 # warn "1=>".@$rtags[$i].@$rsubfields[$i]." = ".@$rvalues[$i].": ".$field->as_formatted;
570 $prevtag = @$rtags[$i];
572 if (@$rtags[$i] <10) {
573 $prevvalue=@$rvalues[$i];
575 if (length(@$rvalues[$i])>0) {
576 $field->add_subfields(@$rsubfields[$i] => @$rvalues[$i]);
577 # warn "2=>".@$rtags[$i].@$rsubfields[$i]." = ".@$rvalues[$i].": ".$field->as_formatted;
580 $prevtag= @$rtags[$i];
583 # the last has not been included inside the loop... do it now !
584 $record->add_fields($field) if $field;
585 # warn "HTML2MARC=".$record->as_formatted;
590 =head2 $hash = &MARCmarc2koha($dbh,$MARCRecord);
594 builds a hash with old-db datas from a MARC::Record
601 my ($dbh,$record,$frameworkcode) = @_;
602 my $sth=$dbh->prepare("select tagfield,tagsubfield from marc_subfield_structure where frameworkcode=? and kohafield=?");
604 my $sth2=$dbh->prepare("SHOW COLUMNS from biblio");
607 while (($field)=$sth2->fetchrow) {
608 $result=&MARCmarc2kohaOneField($sth,"biblio",$field,$record,$result,$frameworkcode);
610 $sth2=$dbh->prepare("SHOW COLUMNS from biblioitems");
612 while (($field)=$sth2->fetchrow) {
613 if ($field eq 'notes') { $field = 'bnotes'; }
614 $result=&MARCmarc2kohaOneField($sth,"biblioitems",$field,$record,$result,$frameworkcode);
616 $sth2=$dbh->prepare("SHOW COLUMNS from items");
618 while (($field)=$sth2->fetchrow) {
619 $result=&MARCmarc2kohaOneField($sth,"items",$field,$record,$result,$frameworkcode);
621 # additional authors : specific
622 $result = &MARCmarc2kohaOneField($sth,"bibliosubtitle","subtitle",$record,$result,$frameworkcode);
623 $result = &MARCmarc2kohaOneField($sth,"additionalauthors","additionalauthors",$record,$result,$frameworkcode);
624 # modify copyrightdate to keep only the 1st year found
625 my $temp = $result->{'copyrightdate'};
626 $temp =~ m/c(\d\d\d\d)/; # search cYYYY first
628 $result->{'copyrightdate'} = $1;
629 } else { # if no cYYYY, get the 1st date.
630 $temp =~ m/(\d\d\d\d)/;
631 $result->{'copyrightdate'} = $1;
633 # modify publicationyear to keep only the 1st year found
634 $temp = $result->{'publicationyear'};
635 $temp =~ m/c(\d\d\d\d)/; # search cYYYY first
637 $result->{'publicationyear'} = $1;
638 } else { # if no cYYYY, get the 1st date.
639 $temp =~ m/(\d\d\d\d)/;
640 $result->{'publicationyear'} = $1;
645 sub MARCmarc2kohaOneField {
647 # FIXME ? if a field has a repeatable subfield that is used in old-db, only the 1st will be retrieved...
648 my ( $sth, $kohatable, $kohafield, $record, $result,$frameworkcode ) = @_;
649 # warn "kohatable / $kohafield / $result / ";
653 ( $tagfield, $subfield ) = MARCfind_marc_from_kohafield("",$kohatable.".".$kohafield,$frameworkcode);
654 foreach my $field ( $record->field($tagfield) ) {
655 if ($field->tag()<10) {
656 if ($result->{$kohafield}) {
657 $result->{$kohafield} .= " | ".$field->data();
659 $result->{$kohafield} = $field->data();
662 if ( $field->subfields ) {
663 my @subfields = $field->subfields();
664 foreach my $subfieldcount ( 0 .. $#subfields ) {
665 if ($subfields[$subfieldcount][0] eq $subfield) {
666 if ( $result->{$kohafield} ) {
667 $result->{$kohafield} .= " | " . $subfields[$subfieldcount][1];
670 $result->{$kohafield} = $subfields[$subfieldcount][1];
677 # warn "OneField for $kohatable.$kohafield and $frameworkcode=> $tagfield, $subfield";
681 =head2 ($biblionumber,$biblioitemnumber) = NEWnewbibilio($dbh,$MARCRecord,$frameworkcode);
685 creates a biblio from a MARC::Record.
692 my ( $dbh, $record, $frameworkcode ) = @_;
694 my $biblioitemnumber;
695 my $olddata = MARCmarc2koha( $dbh, $record,$frameworkcode );
696 $olddata->{frameworkcode} = $frameworkcode;
697 $biblionumber = REALnewbiblio( $dbh, $olddata );
698 $olddata->{biblionumber} = $biblionumber;
699 # add biblionumber into the MARC record (it's the ID for zebra)
700 my ( $tagfield, $tagsubfield ) =
701 MARCfind_marc_from_kohafield( $dbh, "biblio.biblionumber",$frameworkcode );
705 $newfield = MARC::Field->new(
706 $tagfield, $biblionumber,
709 $newfield = MARC::Field->new(
710 $tagfield, '', '', "$tagsubfield" => $biblionumber,
713 # drop old field (just in case it already exist and create new one...
714 my $old_field = $record->field($tagfield);
715 $record->delete_field($old_field);
716 $record->add_fields($newfield);
718 #create the marc entry, that stores the rax marc record in Koha 3.0
719 $olddata->{marc} = $record->as_usmarc();
720 $olddata->{marcxml} = $record->as_xml();
721 # and create biblioitem, that's all folks !
722 $biblioitemnumber = REALnewbiblioitem( $dbh, $olddata );
724 # search subtiles, addiauthors and subjects
725 ( $tagfield, $tagsubfield ) =
726 MARCfind_marc_from_kohafield( $dbh, "additionalauthors.author",$frameworkcode );
727 my @addiauthfields = $record->field($tagfield);
728 foreach my $addiauthfield (@addiauthfields) {
729 my @addiauthsubfields = $addiauthfield->subfield($tagsubfield);
730 foreach my $subfieldcount ( 0 .. $#addiauthsubfields ) {
731 REALmodaddauthor( $dbh, $biblionumber,
732 $addiauthsubfields[$subfieldcount] );
735 ( $tagfield, $tagsubfield ) =
736 MARCfind_marc_from_kohafield( $dbh, "bibliosubtitle.subtitle",$frameworkcode );
737 my @subtitlefields = $record->field($tagfield);
738 foreach my $subtitlefield (@subtitlefields) {
739 my @subtitlesubfields = $subtitlefield->subfield($tagsubfield);
740 foreach my $subfieldcount ( 0 .. $#subtitlesubfields ) {
741 REALnewsubtitle( $dbh, $biblionumber,
742 $subtitlesubfields[$subfieldcount] );
745 ( $tagfield, $tagsubfield ) =
746 MARCfind_marc_from_kohafield( $dbh, "bibliosubject.subject",$frameworkcode );
747 my @subj = $record->field($tagfield);
749 foreach my $subject (@subj) {
750 my @subjsubfield = $subject->subfield($tagsubfield);
751 foreach my $subfieldcount ( 0 .. $#subjsubfield ) {
752 push @subjects, $subjsubfield[$subfieldcount];
755 REALmodsubject( $dbh, $biblionumber, 1, @subjects );
756 return ( $biblionumber, $biblioitemnumber );
759 =head2 NEWmodbilbioframework($dbh,$biblionumber,$frameworkcode);
763 modify the framework of a biblio
769 sub NEWmodbiblioframework {
770 my ($dbh,$biblionumber,$frameworkcode) =@_;
771 my $sth = $dbh->prepare("Update biblio SET frameworkcode=? WHERE biblionumber=?");
772 $sth->execute($frameworkcode,$biblionumber);
776 =head2 NEWmodbiblio($dbh,$MARCrecord,$biblionumber,$frameworkcode);
780 modify a biblio (MARC=ON)
787 my ($dbh,$record,$biblionumber,$frameworkcode) =@_;
788 $frameworkcode="" unless $frameworkcode;
789 # &MARCmodbiblio($dbh,$bibid,$record,$frameworkcode,0);
790 my $oldbiblio = MARCmarc2koha($dbh,$record,$frameworkcode);
792 $oldbiblio->{frameworkcode} = $frameworkcode;
793 #create the marc entry, that stores the rax marc record in Koha 3.0
794 $oldbiblio->{marc} = $record->as_usmarc();
795 $oldbiblio->{marcxml} = $record->as_xml();
797 REALmodbiblio($dbh,$oldbiblio);
798 REALmodbiblioitem($dbh,$oldbiblio);
799 # now, modify addi authors, subject, addititles.
800 my ($tagfield,$tagsubfield) = MARCfind_marc_from_kohafield($dbh,"additionalauthors.author",$frameworkcode);
801 my @addiauthfields = $record->field($tagfield);
802 foreach my $addiauthfield (@addiauthfields) {
803 my @addiauthsubfields = $addiauthfield->subfield($tagsubfield);
804 foreach my $subfieldcount (0..$#addiauthsubfields) {
805 REALmodaddauthor($dbh,$biblionumber,$addiauthsubfields[$subfieldcount]);
808 ($tagfield,$tagsubfield) = MARCfind_marc_from_kohafield($dbh,"bibliosubtitle.subtitle",$frameworkcode);
809 my @subtitlefields = $record->field($tagfield);
810 foreach my $subtitlefield (@subtitlefields) {
811 my @subtitlesubfields = $subtitlefield->subfield($tagsubfield);
812 # delete & create subtitle again because REALmodsubtitle can't handle new subtitles
814 $dbh->do("delete from bibliosubtitle where biblionumber=$biblionumber");
815 foreach my $subfieldcount (0..$#subtitlesubfields) {
816 foreach my $subtit(split /\||#/,$subtitlesubfields[$subfieldcount]) {
817 REALnewsubtitle($dbh,$biblionumber,$subtit);
821 ($tagfield,$tagsubfield) = MARCfind_marc_from_kohafield($dbh,"bibliosubject.subject",$frameworkcode);
822 my @subj = $record->field($tagfield);
824 foreach my $subject (@subj) {
825 my @subjsubfield = $subject->subfield($tagsubfield);
826 foreach my $subfieldcount (0..$#subjsubfield) {
827 push @subjects,$subjsubfield[$subfieldcount];
830 REALmodsubject($dbh,$biblionumber,1,@subjects);
834 =head2 NEWmodbilbioframework($dbh,$biblionumber,$frameworkcode);
845 my ( $dbh, $bibid ) = @_;
846 my $biblio = &MARCfind_oldbiblionumber_from_MARCbibid( $dbh, $bibid );
847 &REALdelbiblio( $dbh, $biblio );
850 "select biblioitemnumber from biblioitems where biblionumber=?");
851 $sth->execute($biblio);
852 while ( my ($biblioitemnumber) = $sth->fetchrow ) {
853 REALdelbiblioitem( $dbh, $biblioitemnumber );
855 &MARCdelbiblio( $dbh, $bibid, 0 );
858 =head2 $itemnumber = NEWnewitem($dbh, $record, $biblionumber, $biblioitemnumber);
862 creates an item from a MARC::Record
869 my ( $dbh, $record, $biblionumber, $biblioitemnumber ) = @_;
872 my $frameworkcode=MARCfind_frameworkcode($dbh,$biblionumber);
873 my $item = &MARCmarc2koha( $dbh, $record,$frameworkcode );
874 # needs old biblionumber and biblioitemnumber
875 $item->{'biblionumber'} = $biblionumber;
876 $item->{'biblioitemnumber'}=$biblioitemnumber;
877 $item->{marc} = $record->as_usmarc();
878 my ( $itemnumber, $error ) = &REALnewitems( $dbh, $item, $item->{barcode} );
883 =head2 $itemnumber = NEWmoditem($dbh, $record, $biblionumber, $biblioitemnumber,$itemnumber);
894 my ( $dbh, $record, $biblionumber, $biblioitemnumber, $itemnumber) = @_;
896 my $frameworkcode=MARCfind_frameworkcode($dbh,$biblionumber);
897 my $olditem = MARCmarc2koha( $dbh, $record,$frameworkcode );
899 $olditem->{marc} = $record->as_usmarc();
900 $olditem->{biblionumber} = $biblionumber;
901 $olditem->{biblioitemnumber} = $biblioitemnumber;
903 REALmoditem( $dbh, $olditem );
907 =head2 $itemnumber = NEWdelitem($dbh, $biblionumber, $biblioitemnumber, $itemnumber);
918 my ( $dbh, $bibid, $itemnumber ) = @_;
919 my $biblio = &MARCfind_oldbiblionumber_from_MARCbibid( $dbh, $bibid );
920 &REALdelitem( $dbh, $itemnumber );
921 &MARCdelitem( $dbh, $bibid, $itemnumber );
925 =head2 $biblionumber = REALnewbiblio($dbh,$biblio);
929 adds a record in biblio table. Datas are in the hash $biblio.
936 my ( $dbh, $biblio ) = @_;
938 $dbh->do('lock tables biblio WRITE');
939 my $sth = $dbh->prepare("Select max(biblionumber) from biblio");
941 my $data = $sth->fetchrow_arrayref;
942 my $bibnum = $$data[0] + 1;
945 if ( $biblio->{'seriestitle'} ) { $series = 1 }
948 $dbh->prepare("insert into biblio set biblionumber=?, title=?, author=?, copyrightdate=?,
949 serial=?, seriestitle=?, notes=?, abstract=?,
953 $bibnum, $biblio->{'title'},
954 $biblio->{'author'}, $biblio->{'copyrightdate'},
955 $biblio->{'serial'}, $biblio->{'seriestitle'},
956 $biblio->{'notes'}, $biblio->{'abstract'},
957 $biblio->{'unititle'}
961 $dbh->do('unlock tables');
965 =head2 $biblionumber = REALmodbiblio($dbh,$biblio);
969 modify a record in biblio table. Datas are in the hash $biblio.
976 my ( $dbh, $biblio ) = @_;
977 my $sth = $dbh->prepare("Update biblio set title=?, author=?, abstract=?, copyrightdate=?,
978 seriestitle=?, serial=?, unititle=?, notes=?, frameworkcode=?
979 where biblionumber = ?"
982 $biblio->{'title'}, $biblio->{'author'},
983 $biblio->{'abstract'}, $biblio->{'copyrightdate'},
984 $biblio->{'seriestitle'}, $biblio->{'serial'},
985 $biblio->{'unititle'}, $biblio->{'notes'},
986 $biblio->{frameworkcode},
987 $biblio->{'biblionumber'}
990 return ( $biblio->{'biblionumber'} );
993 =head2 REALmodsubtitle($dbh,$bibnum,$subtitle);
997 modify subtitles in bibliosubtitle table.
1003 sub REALmodsubtitle {
1004 my ( $dbh, $bibnum, $subtitle ) = @_;
1007 "update bibliosubtitle set subtitle = ? where biblionumber = ?");
1008 $sth->execute( $subtitle, $bibnum );
1012 =head2 REALmodaddauthor($dbh,$bibnum,$author);
1016 adds or modify additional authors
1017 NOTE : Strange sub : seems to delete MANY and add only ONE author... maybe buggy ?
1023 sub REALmodaddauthor {
1024 my ( $dbh, $bibnum, @authors ) = @_;
1026 # my $dbh = C4Connect;
1028 $dbh->prepare("Delete from additionalauthors where biblionumber = ?");
1030 $sth->execute($bibnum);
1032 foreach my $author (@authors) {
1033 if ( $author ne '' ) {
1036 "Insert into additionalauthors set author = ?, biblionumber = ?"
1039 $sth->execute( $author, $bibnum );
1044 } # sub modaddauthor
1046 =head2 $errors = REALmodsubject($dbh,$bibnum, $force, @subject);
1050 modify/adds subjects
1055 sub REALmodsubject {
1056 my ( $dbh, $bibnum, $force, @subject ) = @_;
1058 # my $dbh = C4Connect;
1059 my $count = @subject;
1061 for ( my $i = 0 ; $i < $count ; $i++ ) {
1062 $subject[$i] =~ s/^ //g;
1063 $subject[$i] =~ s/ $//g;
1066 "select * from catalogueentry where entrytype = 's' and catalogueentry = ?"
1068 $sth->execute( $subject[$i] );
1070 if ( my $data = $sth->fetchrow_hashref ) {
1073 if ( $force eq $subject[$i] || $force == 1 ) {
1075 # subject not in aut, chosen to force anway
1076 # so insert into cataloguentry so its in auth file
1079 "Insert into catalogueentry (entrytype,catalogueentry) values ('s',?)"
1082 $sth2->execute( $subject[$i] ) if ( $subject[$i] );
1087 "$subject[$i]\n does not exist in the subject authority file";
1090 "Select * from catalogueentry where entrytype = 's' and (catalogueentry like ? or catalogueentry like ? or catalogueentry like ?)"
1092 $sth2->execute( "$subject[$i] %", "% $subject[$i] %",
1094 while ( my $data = $sth2->fetchrow_hashref ) {
1095 $error .= "<br>$data->{'catalogueentry'}";
1102 if ( $error eq '' ) {
1104 $dbh->prepare("Delete from bibliosubject where biblionumber = ?");
1105 $sth->execute($bibnum);
1109 "Insert into bibliosubject (subject,biblionumber) values (?,?)");
1111 foreach $query (@subject) {
1112 $sth->execute( $query, $bibnum ) if ( $query && $bibnum );
1121 =head2 REALmodbiblioitem($dbh, $biblioitem);
1130 sub REALmodbiblioitem {
1131 my ( $dbh, $biblioitem ) = @_;
1134 my $sth = $dbh->prepare("update biblioitems set itemtype=?, url=?, isbn=?, issn=?,
1135 publishercode=?, publicationyear=?, classification=?, dewey=?,
1136 subclass=?, illus=?, pages=?, volumeddesc=?,
1137 notes=?, size=?, place=?, marc=?,
1139 where biblioitemnumber=?");
1140 $sth->execute( $biblioitem->{itemtype}, $biblioitem->{url}, $biblioitem->{isbn}, $biblioitem->{issn},
1141 $biblioitem->{publishercode}, $biblioitem->{publicationyear}, $biblioitem->{classification}, $biblioitem->{dewey},
1142 $biblioitem->{subclass}, $biblioitem->{illus}, $biblioitem->{pages}, $biblioitem->{volumeddesc},
1143 $biblioitem->{bnotes}, $biblioitem->{size}, $biblioitem->{place}, $biblioitem->{marc},
1144 $biblioitem->{marcxml}, $biblioitem->{biblioitemnumber});
1145 my $record = MARC::File::USMARC::decode($biblioitem->{marc});
1146 zebra_create($biblioitem->{biblionumber}, $record);
1147 # warn "MOD : $biblioitem->{biblioitemnumber} = ".$biblioitem->{marc};
1150 =head2 REALnewbiblioitem($dbh,$biblioitem);
1154 adds a biblioitem ($biblioitem is a hash with the values)
1160 sub REALnewbiblioitem {
1161 my ( $dbh, $biblioitem ) = @_;
1163 $dbh->do("lock tables biblioitems WRITE, biblio WRITE");
1164 my $sth = $dbh->prepare("Select max(biblioitemnumber) from biblioitems");
1166 my $biblioitemnumber;
1169 $data = $sth->fetchrow_arrayref;
1170 $biblioitemnumber = $$data[0] + 1;
1172 # Insert biblioitemnumber in MARC record, we need it to manage items later...
1173 my $frameworkcode=MARCfind_frameworkcode($dbh,$biblioitem->{biblionumber});
1174 my ($biblioitemnumberfield,$biblioitemnumbersubfield) = MARCfind_marc_from_kohafield($dbh,'biblioitems.biblioitemnumber',$frameworkcode);
1175 my $record = MARC::File::USMARC::decode($biblioitem->{marc});
1176 my $field=$record->field($biblioitemnumberfield);
1177 $field->update($biblioitemnumbersubfield => "$biblioitemnumber");
1178 $biblioitem->{marc} = $record->as_usmarc();
1179 $biblioitem->{marcxml} = $record->as_xml();
1181 $sth = $dbh->prepare( "insert into biblioitems set
1182 biblioitemnumber = ?, biblionumber = ?,
1183 volume = ?, number = ?,
1184 classification = ?, itemtype = ?,
1186 issn = ?, dewey = ?,
1187 subclass = ?, publicationyear = ?,
1188 publishercode = ?, volumedate = ?,
1189 volumeddesc = ?, illus = ?,
1190 pages = ?, notes = ?,
1192 marc = ?, place = ?,
1196 $biblioitemnumber, $biblioitem->{'biblionumber'},
1197 $biblioitem->{'volume'}, $biblioitem->{'number'},
1198 $biblioitem->{'classification'}, $biblioitem->{'itemtype'},
1199 $biblioitem->{'url'}, $biblioitem->{'isbn'},
1200 $biblioitem->{'issn'}, $biblioitem->{'dewey'},
1201 $biblioitem->{'subclass'}, $biblioitem->{'publicationyear'},
1202 $biblioitem->{'publishercode'}, $biblioitem->{'volumedate'},
1203 $biblioitem->{'volumeddesc'}, $biblioitem->{'illus'},
1204 $biblioitem->{'pages'}, $biblioitem->{'bnotes'},
1205 $biblioitem->{'size'}, $biblioitem->{'lccn'},
1206 $biblioitem->{'marc'}, $biblioitem->{'place'},
1207 $biblioitem->{marcxml},
1209 $dbh->do("unlock tables");
1210 zebra_create($biblioitem->{biblionumber}, $record);
1211 return ($biblioitemnumber);
1214 =head2 REALnewsubtitle($dbh,$bibnum,$subtitle);
1218 create a new subtitle
1223 sub REALnewsubtitle {
1224 my ( $dbh, $bibnum, $subtitle ) = @_;
1227 "insert into bibliosubtitle set biblionumber = ?, subtitle = ?");
1228 $sth->execute( $bibnum, $subtitle ) if $subtitle;
1232 =head2 ($itemnumber,$errors)= REALnewitems($dbh,$item,$barcode);
1236 create a item. $item is a hash and $barcode the barcode.
1243 my ( $dbh, $item, $barcode ) = @_;
1245 # warn "OLDNEWITEMS";
1247 $dbh->do('lock tables items WRITE, biblio WRITE,biblioitems WRITE');
1248 my $sth = $dbh->prepare("Select max(itemnumber) from items");
1253 $data = $sth->fetchrow_hashref;
1254 $itemnumber = $data->{'max(itemnumber)'} + 1;
1256 # FIXME the "notforloan" field seems to be named "loan" in some places. workaround bugfix.
1257 if ( $item->{'loan'} ) {
1258 $item->{'notforloan'} = $item->{'loan'};
1261 # if dateaccessioned is provided, use it. Otherwise, set to NOW()
1262 if ( $item->{'dateaccessioned'} ) {
1263 $sth = $dbh->prepare( "Insert into items set
1264 itemnumber = ?, biblionumber = ?,
1265 multivolumepart = ?,
1266 biblioitemnumber = ?, barcode = ?,
1267 booksellerid = ?, dateaccessioned = ?,
1268 homebranch = ?, holdingbranch = ?,
1269 price = ?, replacementprice = ?,
1270 replacementpricedate = NOW(), datelastseen = NOW(),
1271 multivolume = ?, stack = ?,
1272 itemlost = ?, wthdrawn = ?,
1273 paidfor = ?, itemnotes = ?,
1274 itemcallnumber =?, notforloan = ?,
1279 $itemnumber, $item->{'biblionumber'},
1280 $item->{'multivolumepart'},
1281 $item->{'biblioitemnumber'},$barcode,
1282 $item->{'booksellerid'}, $item->{'dateaccessioned'},
1283 $item->{'homebranch'}, $item->{'holdingbranch'},
1284 $item->{'price'}, $item->{'replacementprice'},
1285 $item->{multivolume}, $item->{stack},
1286 $item->{itemlost}, $item->{wthdrawn},
1287 $item->{paidfor}, $item->{'itemnotes'},
1288 $item->{'itemcallnumber'}, $item->{'notforloan'},
1291 if ( defined $sth->errstr ) {
1292 $error .= $sth->errstr;
1296 $sth = $dbh->prepare( "Insert into items set
1297 itemnumber = ?, biblionumber = ?,
1298 multivolumepart = ?,
1299 biblioitemnumber = ?, barcode = ?,
1300 booksellerid = ?, dateaccessioned = NOW(),
1301 homebranch = ?, holdingbranch = ?,
1302 price = ?, replacementprice = ?,
1303 replacementpricedate = NOW(), datelastseen = NOW(),
1304 multivolume = ?, stack = ?,
1305 itemlost = ?, wthdrawn = ?,
1306 paidfor = ?, itemnotes = ?,
1307 itemcallnumber =?, notforloan = ?,
1312 $itemnumber, $item->{'biblionumber'},
1313 $item->{'multivolumepart'},
1314 $item->{'biblioitemnumber'},$barcode,
1315 $item->{'booksellerid'},
1316 $item->{'homebranch'}, $item->{'holdingbranch'},
1317 $item->{'price'}, $item->{'replacementprice'},
1318 $item->{multivolume}, $item->{stack},
1319 $item->{itemlost}, $item->{wthdrawn},
1320 $item->{paidfor}, $item->{'itemnotes'},
1321 $item->{'itemcallnumber'}, $item->{'notforloan'},
1324 if ( defined $sth->errstr ) {
1325 $error .= $sth->errstr;
1328 # item stored, now, deal with the marc part...
1329 $sth = $dbh->prepare("select biblioitems.marc,biblio.frameworkcode from biblioitems,biblio
1330 where biblio.biblionumber=biblioitems.biblionumber and
1331 biblio.biblionumber=?");
1332 $sth->execute($item->{biblionumber});
1333 if ( defined $sth->errstr ) {
1334 $error .= $sth->errstr;
1336 my ($rawmarc,$frameworkcode) = $sth->fetchrow;
1337 warn "ERROR IN OLDnewitem, MARC record not found FOR $item->{biblionumber} => $rawmarc <=" unless $rawmarc;
1338 my $record = MARC::File::USMARC::decode($rawmarc);
1339 # ok, we have the marc record, add item number to the item field (in {marc}, and add the field to the record)
1340 my ($itemnumberfield,$itemnumbersubfield) = MARCfind_marc_from_kohafield($dbh,'items.itemnumber',$frameworkcode);
1341 my $itemrecord = MARC::File::USMARC::decode($item->{marc});
1342 my $itemfield = $itemrecord->field($itemnumberfield);
1343 $itemfield->add_subfields($itemnumbersubfield => "$itemnumber");
1344 $record->insert_grouped_field($itemfield);
1345 # save the record into biblioitem
1346 $sth=$dbh->prepare("update biblioitems set marc=?,marcxml=? where biblionumber=?");
1347 $sth->execute($record->as_usmarc(),$record->as_xml(),$item->{biblionumber});
1348 if ( defined $sth->errstr ) {
1349 $error .= $sth->errstr;
1351 zebra_create($item->{biblionumber},$record);
1352 $dbh->do('unlock tables');
1353 return ( $itemnumber, $error );
1356 =head2 REALmoditem($dbh,$item);
1367 my ( $dbh, $item ) = @_;
1369 $dbh->do('lock tables items WRITE, biblio WRITE,biblioitems WRITE');
1370 $item->{'itemnum'} = $item->{'itemnumber'} unless $item->{'itemnum'};
1371 my $query = "update items set barcode=?,itemnotes=?,itemcallnumber=?,notforloan=?,location=?,multivolumepart=?,multivolume=?,stack=?,wthdrawn=?";
1373 $item->{'barcode'}, $item->{'notes'},
1374 $item->{'itemcallnumber'}, $item->{'notforloan'},
1375 $item->{'location'}, $item->{multivolumepart},
1376 $item->{multivolume}, $item->{stack},
1379 if ( $item->{'lost'} ne '' ) {
1380 $query = "update items set biblioitemnumber=?,barcode=?,itemnotes=?,homebranch=?,
1381 itemlost=?,wthdrawn=?,itemcallnumber=?,notforloan=?,
1382 location=?,multivolumepart=?,multivolume=?,stack=?,wthdrawn=?";
1384 $item->{'bibitemnum'}, $item->{'barcode'},
1385 $item->{'notes'}, $item->{'homebranch'},
1386 $item->{'lost'}, $item->{'wthdrawn'},
1387 $item->{'itemcallnumber'}, $item->{'notforloan'},
1388 $item->{'location'}, $item->{multivolumepart},
1389 $item->{multivolume}, $item->{stack},
1392 if ($item->{homebranch}) {
1393 $query.=",homebranch=?";
1394 push @bind, $item->{homebranch};
1396 if ($item->{holdingbranch}) {
1397 $query.=",holdingbranch=?";
1398 push @bind, $item->{holdingbranch};
1401 $query.=" where itemnumber=?";
1402 push @bind,$item->{'itemnum'};
1403 if ( $item->{'replacement'} ne '' ) {
1404 $query =~ s/ where/,replacementprice='$item->{'replacement'}' where/;
1406 my $sth = $dbh->prepare($query);
1407 $sth->execute(@bind);
1409 # item stored, now, deal with the marc part...
1410 $sth = $dbh->prepare("select biblioitems.marc,biblio.frameworkcode from biblioitems,biblio
1411 where biblio.biblionumber=biblioitems.biblionumber and
1412 biblio.biblionumber=? and
1413 biblioitems.biblioitemnumber=?");
1414 $sth->execute($item->{biblionumber},$item->{biblioitemnumber});
1415 if ( defined $sth->errstr ) {
1416 $error .= $sth->errstr;
1418 my ($rawmarc,$frameworkcode) = $sth->fetchrow;
1419 warn "ERROR IN REALmoditem, MARC record not found" unless $rawmarc;
1420 my $record = MARC::File::USMARC::decode($rawmarc);
1421 # ok, we have the marc record, find the previous item record for this itemnumber and delete it
1422 my ($itemnumberfield,$itemnumbersubfield) = MARCfind_marc_from_kohafield($dbh,'items.itemnumber',$frameworkcode);
1423 # prepare the new item record
1424 my $itemrecord = MARC::File::USMARC::decode($item->{marc});
1425 my $itemfield = $itemrecord->field($itemnumberfield);
1426 $itemfield->add_subfields($itemnumbersubfield => '$itemnumber');
1427 # parse all fields fields from the complete record
1428 foreach ($record->field($itemnumberfield)) {
1429 # when the previous field is found, replace by the new one
1430 if ($_->subfield($itemnumbersubfield) == $item->{itemnum}) {
1431 $_->replace_with($itemfield);
1434 # $record->insert_grouped_field($itemfield);
1435 # save the record into biblioitem
1436 $sth=$dbh->prepare("update biblioitems set marc=?,marcxml=? where biblionumber=? and biblioitemnumber=?");
1437 $sth->execute($record->as_usmarc(),$record->as_xml(),$item->{biblionumber},$item->{biblioitemnumber});
1438 zebra_create($item->biblionumber,$record);
1439 if ( defined $sth->errstr ) {
1440 $error .= $sth->errstr;
1442 $dbh->do('unlock tables');
1447 =head2 REALdelitem($dbh,$itemnum);
1458 my ( $dbh, $itemnum ) = @_;
1460 # my $dbh=C4Connect;
1461 my $sth = $dbh->prepare("select * from items where itemnumber=?");
1462 $sth->execute($itemnum);
1463 my $data = $sth->fetchrow_hashref;
1465 my $query = "Insert into deleteditems set ";
1467 foreach my $temp ( keys %$data ) {
1468 $query .= "$temp = ?,";
1469 push ( @bind, $data->{$temp} );
1474 $sth = $dbh->prepare($query);
1475 $sth->execute(@bind);
1477 $sth = $dbh->prepare("Delete from items where itemnumber=?");
1478 $sth->execute($itemnum);
1484 =head2 REALdelbiblioitem($dbh,$biblioitemnumber);
1488 deletes a biblioitem
1489 NOTE : not standard sub name. Should be REALdelbiblioitem()
1495 sub REALdelbiblioitem {
1496 my ( $dbh, $biblioitemnumber ) = @_;
1498 # my $dbh = C4Connect;
1499 my $sth = $dbh->prepare( "Select * from biblioitems
1500 where biblioitemnumber = ?"
1504 $sth->execute($biblioitemnumber);
1506 if ( $results = $sth->fetchrow_hashref ) {
1510 "Insert into deletedbiblioitems (biblioitemnumber, biblionumber, volume, number, classification, itemtype,
1511 isbn, issn ,dewey ,subclass ,publicationyear ,publishercode ,volumedate ,volumeddesc ,timestamp ,illus ,
1512 pages ,notes ,size ,url ,lccn ) values(?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)"
1516 $results->{biblioitemnumber}, $results->{biblionumber},
1517 $results->{volume}, $results->{number},
1518 $results->{classification}, $results->{itemtype},
1519 $results->{isbn}, $results->{issn},
1520 $results->{dewey}, $results->{subclass},
1521 $results->{publicationyear}, $results->{publishercode},
1522 $results->{volumedate}, $results->{volumeddesc},
1523 $results->{timestamp}, $results->{illus},
1524 $results->{pages}, $results->{notes},
1525 $results->{size}, $results->{url},
1529 $dbh->prepare("Delete from biblioitems where biblioitemnumber = ?");
1530 $sth2->execute($biblioitemnumber);
1535 # Now delete all the items attached to the biblioitem
1536 $sth = $dbh->prepare("Select * from items where biblioitemnumber = ?");
1537 $sth->execute($biblioitemnumber);
1539 while ( my $data = $sth->fetchrow_hashref ) {
1540 my $query = "Insert into deleteditems set ";
1542 foreach my $temp ( keys %$data ) {
1543 $query .= "$temp = ?,";
1544 push ( @bind, $data->{$temp} );
1547 my $sth2 = $dbh->prepare($query);
1548 $sth2->execute(@bind);
1551 $sth = $dbh->prepare("Delete from items where biblioitemnumber = ?");
1552 $sth->execute($biblioitemnumber);
1556 } # sub deletebiblioitem
1558 =head2 REALdelbiblio($dbh,$biblio);
1569 my ( $dbh, $biblio ) = @_;
1570 my $sth = $dbh->prepare("select * from biblio where biblionumber=?");
1571 $sth->execute($biblio);
1572 if ( my $data = $sth->fetchrow_hashref ) {
1574 my $query = "Insert into deletedbiblio set ";
1576 foreach my $temp ( keys %$data ) {
1577 $query .= "$temp = ?,";
1578 push ( @bind, $data->{$temp} );
1581 #replacing the last , by ",?)"
1583 $sth = $dbh->prepare($query);
1584 $sth->execute(@bind);
1586 $sth = $dbh->prepare("Delete from biblio where biblionumber=?");
1587 $sth->execute($biblio);
1593 =head2 $number = itemcount($biblio);
1597 returns the number of items attached to a biblio
1605 my $dbh = C4::Context->dbh;
1608 my $sth = $dbh->prepare("Select count(*) from items where biblionumber=?");
1609 $sth->execute($biblio);
1610 my $data = $sth->fetchrow_hashref;
1612 return ( $data->{'count(*)'} );
1615 =head2 $biblionumber = newbiblio($biblio);
1619 create a biblio. The parameter is a hash
1627 my $dbh = C4::Context->dbh;
1628 my $bibnum = REALnewbiblio( $dbh, $biblio );
1629 # finds new (MARC bibid
1630 # my $bibid = &MARCfind_MARCbibid_from_oldbiblionumber($dbh,$bibnum);
1631 my $record = &MARCkoha2marcBiblio( $dbh, $bibnum );
1632 MARCaddbiblio( $dbh, $record, $bibnum,'' );
1636 =head2 $biblionumber = &modbiblio($biblio);
1640 Update a biblio record.
1642 C<$biblio> is a reference-to-hash whose keys are the fields in the
1643 biblio table in the Koha database. All fields must be present, not
1644 just the ones you wish to change.
1646 C<&modbiblio> updates the record defined by
1647 C<$biblio-E<gt>{biblionumber}> with the values in C<$biblio>.
1649 C<&modbiblio> returns C<$biblio-E<gt>{biblionumber}> whether it was
1658 my $dbh = C4::Context->dbh;
1659 my $biblionumber=REALmodbiblio($dbh,$biblio);
1660 my $record = MARCkoha2marcBiblio($dbh,$biblionumber,$biblionumber);
1661 # finds new (MARC bibid
1662 my $bibid = &MARCfind_MARCbibid_from_oldbiblionumber($dbh,$biblionumber);
1663 MARCmodbiblio($dbh,$bibid,$record,"",0);
1664 return($biblionumber);
1667 =head2 &modsubtitle($biblionumber, $subtitle);
1671 Sets the subtitle of a book.
1673 C<$biblionumber> is the biblionumber of the book to modify.
1675 C<$subtitle> is the new subtitle.
1682 my ( $bibnum, $subtitle ) = @_;
1683 my $dbh = C4::Context->dbh;
1684 &REALmodsubtitle( $dbh, $bibnum, $subtitle );
1687 =head2 &modaddauthor($biblionumber, $author);
1691 Replaces all additional authors for the book with biblio number
1692 C<$biblionumber> with C<$author>. If C<$author> is the empty string,
1693 C<&modaddauthor> deletes all additional authors.
1700 my ( $bibnum, @authors ) = @_;
1701 my $dbh = C4::Context->dbh;
1702 &REALmodaddauthor( $dbh, $bibnum, @authors );
1703 } # sub modaddauthor
1705 =head2 $error = &modsubject($biblionumber, $force, @subjects);
1709 $force - a subject to force
1710 $error - Error message, or undef if successful.
1717 my ( $bibnum, $force, @subject ) = @_;
1718 my $dbh = C4::Context->dbh;
1719 my $error = &REALmodsubject( $dbh, $bibnum, $force, @subject );
1721 # When MARC is off, ensures that the MARC biblio table gets updated with new
1722 # subjects, of course, it deletes the biblio in marc, and then recreates.
1723 # This check is to ensure that no MARC data exists to lose.
1724 if (C4::Context->preference("MARC") eq '0'){
1725 my $MARCRecord = &MARCkoha2marcBiblio($dbh,$bibnum);
1726 my $bibid = &MARCfind_MARCbibid_from_oldbiblionumber($dbh,$bibnum);
1727 &MARCmodbiblio($dbh,$bibid, $MARCRecord);
1733 =head2 modbibitem($biblioitem);
1737 modify a biblioitem. The parameter is a hash
1744 my ($biblioitem) = @_;
1745 my $dbh = C4::Context->dbh;
1746 &REALmodbiblioitem( $dbh, $biblioitem );
1749 =head2 $biblioitemnumber = newbiblioitem($biblioitem)
1753 create a biblioitem, the parameter is a hash
1760 my ($biblioitem) = @_;
1761 my $dbh = C4::Context->dbh;
1762 my $bibitemnum = &REALnewbiblioitem( $dbh, $biblioitem );
1765 MARCkoha2marcBiblio( $dbh, 0, $bibitemnum )
1766 ; # the 0 means "do NOT retrieve biblio, only biblioitem, in the MARC record
1768 &MARCfind_MARCbibid_from_oldbiblionumber( $dbh,
1769 $biblioitem->{biblionumber} );
1770 &MARCaddbiblio( $dbh, $MARCbiblio, $biblioitem->{biblionumber}, '',$bibid );
1771 return ($bibitemnum);
1774 =head2 newsubtitle($biblionumber,$subtitle);
1778 insert a subtitle for $biblionumber biblio
1786 my ( $bibnum, $subtitle ) = @_;
1787 my $dbh = C4::Context->dbh;
1788 &REALnewsubtitle( $dbh, $bibnum, $subtitle );
1791 =head2 $errors = newitems($item, @barcodes);
1795 insert items ($item is a hash)
1803 my ( $item, @barcodes ) = @_;
1804 my $dbh = C4::Context->dbh;
1808 foreach my $barcode (@barcodes) {
1809 ( $itemnumber, $error ) = &REALnewitems( $dbh, $item, uc($barcode) );
1812 &MARCkoha2marcItem( $dbh, $item->{biblionumber}, $itemnumber );
1813 &MARCadditem( $dbh, $MARCitem, $item->{biblionumber} );
1818 =head2 moditem($item);
1822 modify an item ($item is a hash with all item informations)
1831 my $dbh = C4::Context->dbh;
1832 &REALmoditem( $dbh, $item );
1834 &MARCkoha2marcItem( $dbh, $item->{'biblionumber'}, $item->{'itemnum'} );
1836 &MARCfind_MARCbibid_from_oldbiblionumber( $dbh, $item->{biblionumber} );
1837 &MARCmoditem( $dbh, $MARCitem, $bibid, $item->{itemnum}, 0 );
1840 =head2 $error = checkitems($count,@barcodes);
1844 check for each @barcode entry that the barcode is not a duplicate
1851 my ( $count, @barcodes ) = @_;
1852 my $dbh = C4::Context->dbh;
1854 my $sth = $dbh->prepare("Select * from items where barcode=?");
1855 for ( my $i = 0 ; $i < $count ; $i++ ) {
1856 $barcodes[$i] = uc $barcodes[$i];
1857 $sth->execute( $barcodes[$i] );
1858 if ( my $data = $sth->fetchrow_hashref ) {
1859 $error .= " Duplicate Barcode: $barcodes[$i]";
1866 =head2 $delitem($itemnum);
1870 delete item $itemnum being the item number to delete
1878 my $dbh = C4::Context->dbh;
1879 &REALdelitem( $dbh, $itemnum );
1882 =head2 deletebiblioitem($biblioitemnumber);
1886 delete the biblioitem $biblioitemnumber
1892 sub deletebiblioitem {
1893 my ($biblioitemnumber) = @_;
1894 my $dbh = C4::Context->dbh;
1895 &REALdelbiblioitem( $dbh, $biblioitemnumber );
1896 } # sub deletebiblioitem
1898 =head2 delbiblio($biblionumber)
1902 delete biblio $biblionumber
1910 my $dbh = C4::Context->dbh;
1911 &REALdelbiblio( $dbh, $biblio );
1912 my $bibid = &MARCfind_MARCbibid_from_oldbiblionumber( $dbh, $biblio );
1913 &MARCdelbiblio( $dbh, $bibid, 0 );
1916 =head2 ($count,@results) = getbiblio($biblionumber);
1920 return an array with hash of biblios.
1922 FIXME : biblionumber being the primary key, this sub will always return only 1 result, API should be modified...
1929 my ($biblionumber) = @_;
1930 my $dbh = C4::Context->dbh;
1931 my $sth = $dbh->prepare("Select * from biblio where biblionumber = ?");
1933 # || die "Cannot prepare $query\n" . $dbh->errstr;
1937 $sth->execute($biblionumber);
1939 # || die "Cannot execute $query\n" . $sth->errstr;
1940 while ( my $data = $sth->fetchrow_hashref ) {
1941 $results[$count] = $data;
1946 return ( $count, @results );
1949 =head2 ($count,@results) = getbiblioitem($biblioitemnumber);
1953 return an array with hash of biblioitemss.
1955 FIXME : biblioitemnumber being unique, this sub will always return only 1 result, API should be modified...
1962 my ($biblioitemnum) = @_;
1963 my $dbh = C4::Context->dbh;
1964 my $sth = $dbh->prepare( "Select * from biblioitems where
1965 biblioitemnumber = ?"
1970 $sth->execute($biblioitemnum);
1972 while ( my $data = $sth->fetchrow_hashref ) {
1973 $results[$count] = $data;
1978 return ( $count, @results );
1979 } # sub getbiblioitem
1981 =head2 ($count,@results) = getbiblioitembybiblionumber($biblionumber);
1985 return an array with hash of biblioitems for the given biblionumber.
1991 sub getbiblioitembybiblionumber {
1992 my ($biblionumber) = @_;
1993 my $dbh = C4::Context->dbh;
1994 my $sth = $dbh->prepare("Select * from biblioitems where biblionumber = ?");
1998 $sth->execute($biblionumber);
2000 while ( my $data = $sth->fetchrow_hashref ) {
2001 $results[$count] = $data;
2006 return ( $count, @results );
2009 =head2 ($count,@results) = getitemsbybiblioitem($biblionumber);
2013 returns an array with hash of items
2019 sub getitemsbybiblioitem {
2020 my ($biblioitemnum) = @_;
2021 my $dbh = C4::Context->dbh;
2022 my $sth = $dbh->prepare( "Select * from items, biblio where
2023 biblio.biblionumber = items.biblionumber and biblioitemnumber
2027 # || die "Cannot prepare $query\n" . $dbh->errstr;
2031 $sth->execute($biblioitemnum);
2033 # || die "Cannot execute $query\n" . $sth->errstr;
2034 while ( my $data = $sth->fetchrow_hashref ) {
2035 $results[$count] = $data;
2040 return ( $count, @results );
2041 } # sub getitemsbybiblioitem
2045 # converts ISO 5426 coded string to ISO 8859-1
2046 # sloppy code : should be improved in next issue
2047 my ( $string, $encoding ) = @_;
2050 # $encoding = C4::Context->preference("marcflavour") unless $encoding;
2051 if ( $encoding eq "UNIMARC" ) {
2120 # this handles non-sorting blocks (if implementation requires this)
2121 $string = nsb_clean($_);
2123 elsif ( $encoding eq "USMARC" || $encoding eq "MARC21" ) {
2124 if (/[\xc1-\xff]/) {
2177 # this handles non-sorting blocks (if implementation requires this)
2178 $string = nsb_clean($_);
2185 my $NSB = '\x88'; # NSB : begin Non Sorting Block
2186 my $NSE = '\x89'; # NSE : Non Sorting Block end
2187 # handles non sorting blocks
2191 s/[ ]{0,1}$NSE/) /gm;
2198 my $dbh = C4::Context->dbh;
2199 my $result = MARCmarc2koha($dbh,$record,'');
2201 my ($biblionumber,$bibid,$title);
2202 # search duplicate on ISBN, easy and fast...
2203 if ($result->{isbn}) {
2204 $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=?");
2205 $sth->execute($result->{'isbn'});
2206 ($biblionumber,$bibid,$title) = $sth->fetchrow;
2207 return $biblionumber,$bibid,$title if ($biblionumber);
2209 # a more complex search : build a request for SearchMarc::catalogsearch()
2210 my (@tags, @and_or, @excluding, @operator, @value, $offset,$length);
2211 # search on biblio.title
2212 my ($tag,$subfield) = MARCfind_marc_from_kohafield($dbh,"biblio.title","");
2213 if ($record->field($tag)) {
2214 if ($record->field($tag)->subfields($subfield)) {
2215 push @tags, "'".$tag.$subfield."'";
2216 push @and_or, "and";
2217 push @excluding, "";
2218 push @operator, "contains";
2219 push @value, $record->field($tag)->subfield($subfield);
2220 # warn "for title, I add $tag / $subfield".$record->field($tag)->subfield($subfield);
2223 # ... and on biblio.author
2224 ($tag,$subfield) = MARCfind_marc_from_kohafield($dbh,"biblio.author","");
2225 if ($record->field($tag)) {
2226 if ($record->field($tag)->subfields($subfield)) {
2227 push @tags, "'".$tag.$subfield."'";
2228 push @and_or, "and";
2229 push @excluding, "";
2230 push @operator, "contains";
2231 push @value, $record->field($tag)->subfield($subfield);
2232 # warn "for author, I add $tag / $subfield".$record->field($tag)->subfield($subfield);
2235 # ... and on publicationyear.
2236 ($tag,$subfield) = MARCfind_marc_from_kohafield($dbh,"biblioitems.publicationyear","");
2237 if ($record->field($tag)) {
2238 if ($record->field($tag)->subfields($subfield)) {
2239 push @tags, "'".$tag.$subfield."'";
2240 push @and_or, "and";
2241 push @excluding, "";
2242 push @operator, "=";
2243 push @value, $record->field($tag)->subfield($subfield);
2244 # warn "for publicationyear, I add $tag / $subfield".$record->field($tag)->subfield($subfield);
2248 ($tag,$subfield) = MARCfind_marc_from_kohafield($dbh,"biblioitems.size","");
2249 if ($record->field($tag)) {
2250 if ($record->field($tag)->subfields($subfield)) {
2251 push @tags, "'".$tag.$subfield."'";
2252 push @and_or, "and";
2253 push @excluding, "";
2254 push @operator, "=";
2255 push @value, $record->field($tag)->subfield($subfield);
2256 # warn "for size, I add $tag / $subfield".$record->field($tag)->subfield($subfield);
2259 # ... and on publisher.
2260 ($tag,$subfield) = MARCfind_marc_from_kohafield($dbh,"biblioitems.publishercode","");
2261 if ($record->field($tag)) {
2262 if ($record->field($tag)->subfields($subfield)) {
2263 push @tags, "'".$tag.$subfield."'";
2264 push @and_or, "and";
2265 push @excluding, "";
2266 push @operator, "=";
2267 push @value, $record->field($tag)->subfield($subfield);
2268 # warn "for publishercode, I add $tag / $subfield".$record->field($tag)->subfield($subfield);
2271 # ... and on volume.
2272 ($tag,$subfield) = MARCfind_marc_from_kohafield($dbh,"biblioitems.volume","");
2273 if ($record->field($tag)) {
2274 if ($record->field($tag)->subfields($subfield)) {
2275 push @tags, "'".$tag.$subfield."'";
2276 push @and_or, "and";
2277 push @excluding, "";
2278 push @operator, "=";
2279 push @value, $record->field($tag)->subfield($subfield);
2280 # warn "for volume, I add $tag / $subfield".$record->field($tag)->subfield($subfield);
2284 my ($finalresult,$nbresult) = C4::SearchMarc::catalogsearch($dbh,\@tags,\@and_or,\@excluding,\@operator,\@value,0,10);
2285 # there is at least 1 result => return the 1st one
2287 # warn "$nbresult => ".@$finalresult[0]->{biblionumber},@$finalresult[0]->{bibid},@$finalresult[0]->{title};
2288 return @$finalresult[0]->{biblionumber},@$finalresult[0]->{bibid},@$finalresult[0]->{title};
2290 # no result, returns nothing
2297 if(substr($isbn, 0, 1) <=7) {
2298 $seg1 = substr($isbn, 0, 1);
2299 } elsif(substr($isbn, 0, 2) <= 94) {
2300 $seg1 = substr($isbn, 0, 2);
2301 } elsif(substr($isbn, 0, 3) <= 995) {
2302 $seg1 = substr($isbn, 0, 3);
2303 } elsif(substr($isbn, 0, 4) <= 9989) {
2304 $seg1 = substr($isbn, 0, 4);
2306 $seg1 = substr($isbn, 0, 5);
2308 my $x = substr($isbn, length($seg1));
2310 if(substr($x, 0, 2) <= 19) {
2311 # if(sTmp2 < 10) sTmp2 = "0" sTmp2;
2312 $seg2 = substr($x, 0, 2);
2313 } elsif(substr($x, 0, 3) <= 699) {
2314 $seg2 = substr($x, 0, 3);
2315 } elsif(substr($x, 0, 4) <= 8399) {
2316 $seg2 = substr($x, 0, 4);
2317 } elsif(substr($x, 0, 5) <= 89999) {
2318 $seg2 = substr($x, 0, 5);
2319 } elsif(substr($x, 0, 6) <= 9499999) {
2320 $seg2 = substr($x, 0, 6);
2322 $seg2 = substr($x, 0, 7);
2324 my $seg3=substr($x,length($seg2));
2325 $seg3=substr($seg3,0,length($seg3)-1) ;
2326 my $seg4 = substr($x, -1, 1);
2327 return "$seg1-$seg2-$seg3-$seg4";
2331 END { } # module clean-up code here (global destructor)
2337 Koha Developement team <info@koha.org>
2339 Paul POULAIN paul.poulain@free.fr
2345 # Revision 1.128 2005/08/11 16:12:47 tipaul
2346 # Playing with the zebra...
2348 # * go to koha cvs home directory
2349 # * in misc/zebra there is a unimarc directory. I suggest that marc21 libraries create a marc21 directory
2350 # * put your zebra.cfg files here & create your database.
2351 # * from koha cvs home directory, ln -s misc/zebra/marc21 zebra (I mean create a symbolic link to YOUR zebra directory)
2352 # * now, everytime you add/modify a biblio/item your zebra DB is updated correctly.
2355 # * this uses a system call in perl. CPU consumming, but we are waiting for indexdata Perl/zoom
2356 # * deletion still not work
2357 # * UNIMARC zebra config files are provided in misc/zebra/unimarc directory. The most important line being :
2359 # recordId: (bib1,Local-number)
2363 # elm 090 Local-number -
2364 # elm 090/? Local-number -
2365 # elm 090/?/9 Local-number !:w
2367 # (090$9 being the field mapped to biblio.biblionumber in Koha)
2369 # Revision 1.127 2005/08/11 14:37:32 tipaul
2371 # * removing useless subs
2372 # * removing some subs that are also elsewhere
2373 # * 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)
2375 # Revision 1.126 2005/08/11 09:13:28 tipaul
2376 # just removing useless subs (a lot !!!) for code cleaning
2378 # Revision 1.125 2005/08/11 09:00:07 tipaul
2379 # Ok guys, this time, it seems that item add and modif begin working as expected...
2380 # Still a lot of bugs to fix, of course
2382 # Revision 1.124 2005/08/10 10:21:15 tipaul
2383 # continuing the road to zebra :
2384 # - the biblio add begins to work.
2385 # - the biblio modif begins to work.
2387 # (still without doing anything on zebra)
2388 # (no new change in updatedatabase)
2390 # Revision 1.123 2005/08/09 14:10:28 tipaul
2391 # 1st commit to go to zebra.
2392 # don't update your cvs if you want to have a working head...
2394 # this commit contains :
2395 # * 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...
2396 # * 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.
2397 # * other files : get rid of bibid and use biblionumber instead.
2400 # * does not do anything on zebra yet.
2401 # * if you rename marc_subfield_table, you can't search anymore.
2402 # * you can view a biblio & bibliodetails, go to MARC editor, but NOT save any modif.
2403 # * 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 ;-) )
2405 # 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
2406 # 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.
2408 # tipaul cutted previous commit notes