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
26 use MARC::File::USMARC;
29 use vars qw($VERSION @ISA @EXPORT);
31 # set the version for version checking
37 # don't forget MARCxxx subs are exported only for testing purposes. Should not be used
38 # as the old-style API and the NEW one are the only public functions.
41 &newbiblio &newbiblioitem
42 &newsubject &newsubtitle &newitems
44 &modbiblio &checkitems &modbibitem
45 &modsubtitle &modsubject &modaddauthor &moditem
47 &delitem &deletebiblioitem &delbiblio
49 &getbiblio &bibdata &bibitems &bibitemdata
50 &barcodes &ItemInfo &itemdata &itemissues &itemcount
51 &getsubject &getaddauthor &getsubtitle
52 &getwebbiblioitems &getwebsites
53 &getbiblioitembybiblionumber
54 &getbiblioitem &getitemsbybiblioitem
56 &MARCfind_marc_from_kohafield
57 &MARCfind_frameworkcode
58 &find_biblioitemnumber
61 &NEWnewbiblio &NEWnewitem
62 &NEWmodbiblio &NEWmoditem
63 &NEWdelbiblio &NEWdelitem
64 &NEWmodbiblioframework
66 &MARCkoha2marcBiblio &MARCmarc2koha
67 &MARCkoha2marcItem &MARChtml2marc
68 &MARCgetbiblio &MARCgetitem
77 C4::Biblio - acquisition, catalog management functions
81 ( lot of changes for Koha 3.0)
83 Koha 1.2 and previous version used a specific API to manage biblios. This API uses old-DB style parameters.
84 They are based on a hash, and store data in biblio/biblioitems/items tables (plus additionalauthors, bibliosubject and bibliosubtitle where applicable)
86 In Koha 2.0, we introduced a MARC-DB.
88 In Koha 3.0 we removed this MARC-DB for search as we wanted to use Zebra as search system.
90 So in Koha 3.0, saving a record means :
91 - storing the raw marc record (iso2709) in biblioitems.marc field. It contains both biblio & items informations.
92 - storing the "decoded information" in biblio/biblioitems/items as previously.
93 - using zebra to manage search & indexing on the MARC datas.
95 In Koha, there is a systempreference saying "MARC=ON" or "MARC=OFF"
97 * MARC=ON : when MARC=ON, koha uses a MARC::Record object (in sub parameters). Saving informations in the DB means :
98 - transform the MARC record into a hash
99 - add the raw marc record into the hash
100 - store them & update zebra
102 * MARC=OFF : when MARC=OFF, koha uses a hash object (in sub parameters). Saving informations in the DB means :
103 - transform the hash into a MARC record
104 - add the raw marc record into the hash
105 - store them and update zebra
108 That's why we need 3 types of subs :
112 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
114 =head2 NEWxxx related subs
118 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.
120 all subs requires/use $dbh as 1st parameter and a MARC::Record object as 2nd parameter. they sometimes requires another parameter.
124 =head2 something_elsexxx related subs
128 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.
130 all subs requires/use $dbh as 1st parameter and a hash as 2nd parameter.
139 my ($biblionumber,$record) = @_;
140 # create the iso2709 file for zebra
141 my $cgidir = C4::Context->intranetdir ."/cgi-bin";
142 unless (opendir(DIR, "$cgidir")) {
143 $cgidir = C4::Context->intranetdir."/";
146 my $filename = $cgidir."/zebra/biblios/BIBLIO".$biblionumber."iso2709";
147 open F,"> $filename";
148 print F $record->as_usmarc();
150 my $res = system("cd $cgidir/zebra;/usr/local/bin/zebraidx update biblios");
154 =head2 @tagslib = &MARCgettagslib($dbh,1|0,$frameworkcode);
158 2nd param is 1 for liblibrarian and 0 for libopac
159 $frameworkcode contains the framework reference. If empty or does not exist, the default one is used
161 returns a hash with all values for all fields and subfields for a given MARC framework :
162 $res->{$tag}->{lib} = ($forlibrarian or !$libopac)?$liblibrarian:$libopac;
164 ->{mandatory} = $mandatory;
165 ->{repeatable} = $repeatable;
166 ->{$subfield}->{lib} = ($forlibrarian or !$libopac)?$liblibrarian:$libopac;
168 ->{mandatory} = $mandatory;
169 ->{repeatable} = $repeatable;
170 ->{authorised_value} = $authorised_value;
171 ->{authtypecode} = $authtypecode;
172 ->{value_builder} = $value_builder;
173 ->{kohafield} = $kohafield;
174 ->{seealso} = $seealso;
175 ->{hidden} = $hidden;
184 my ( $dbh, $forlibrarian, $frameworkcode ) = @_;
185 $frameworkcode = "" unless $frameworkcode;
187 my $libfield = ( $forlibrarian eq 1 ) ? 'liblibrarian' : 'libopac';
189 # check that framework exists
192 "select count(*) from marc_tag_structure where frameworkcode=?");
193 $sth->execute($frameworkcode);
194 my ($total) = $sth->fetchrow;
195 $frameworkcode = "" unless ( $total > 0 );
198 "select tagfield,liblibrarian,libopac,mandatory,repeatable from marc_tag_structure where frameworkcode=? order by tagfield"
200 $sth->execute($frameworkcode);
201 my ( $liblibrarian, $libopac, $tag, $res, $tab, $mandatory, $repeatable );
203 while ( ( $tag, $liblibrarian, $libopac, $mandatory, $repeatable ) = $sth->fetchrow ) {
204 $res->{$tag}->{lib} = ($forlibrarian or !$libopac)?$liblibrarian:$libopac;
205 $res->{$tag}->{tab} = ""; # XXX
206 $res->{$tag}->{mandatory} = $mandatory;
207 $res->{$tag}->{repeatable} = $repeatable;
212 "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"
214 $sth->execute($frameworkcode);
217 my $authorised_value;
227 ( $tag, $subfield, $liblibrarian, , $libopac, $tab,
228 $mandatory, $repeatable, $authorised_value, $authtypecode,
229 $value_builder, $kohafield, $seealso, $hidden,
234 $res->{$tag}->{$subfield}->{lib} = ($forlibrarian or !$libopac)?$liblibrarian:$libopac;
235 $res->{$tag}->{$subfield}->{tab} = $tab;
236 $res->{$tag}->{$subfield}->{mandatory} = $mandatory;
237 $res->{$tag}->{$subfield}->{repeatable} = $repeatable;
238 $res->{$tag}->{$subfield}->{authorised_value} = $authorised_value;
239 $res->{$tag}->{$subfield}->{authtypecode} = $authtypecode;
240 $res->{$tag}->{$subfield}->{value_builder} = $value_builder;
241 $res->{$tag}->{$subfield}->{kohafield} = $kohafield;
242 $res->{$tag}->{$subfield}->{seealso} = $seealso;
243 $res->{$tag}->{$subfield}->{hidden} = $hidden;
244 $res->{$tag}->{$subfield}->{isurl} = $isurl;
245 $res->{$tag}->{$subfield}->{link} = $link;
250 =head2 ($tagfield,$tagsubfield) = &MARCfind_marc_from_kohafield($dbh,$kohafield);
254 finds MARC tag and subfield for a given kohafield
255 kohafield is "table.field" where table= biblio|biblioitems|items, and field a field of the previous table
261 sub MARCfind_marc_from_kohafield {
262 my ( $dbh, $kohafield,$frameworkcode ) = @_;
263 return 0, 0 unless $kohafield;
264 my $relations = C4::Context->marcfromkohafield;
265 return ($relations->{$frameworkcode}->{$kohafield}->[0],$relations->{$frameworkcode}->{$kohafield}->[1]);
268 =head2 $MARCRecord = &MARCgetbiblio($dbh,$biblionumber);
272 Returns a MARC::Record for the biblio $biblionumber.
278 # Returns MARC::Record of the biblio passed in parameter.
279 my ( $dbh, $biblionumber ) = @_;
280 my $sth = $dbh->prepare('select marcxml from biblioitems where biblionumber=?');
281 $sth->execute($biblionumber);
282 my ($marc) = $sth->fetchrow;
283 my $record = MARC::Record::new_from_xml($marc);
287 =head2 $MARCrecord = &MARCgetitem($dbh,$biblionumber);
291 Returns a MARC::Record with all items of biblio # $biblionumber
299 my ( $dbh, $biblionumber, $itemnumber ) = @_;
300 my $frameworkcode=MARCfind_frameworkcode($dbh,$biblionumber);
301 # get the complete MARC record
302 my $sth = $dbh->prepare("select marc from biblioitems where biblionumber=?");
303 $sth->execute($biblionumber);
304 my ($rawmarc) = $sth->fetchrow;
305 my $record = MARC::File::USMARC::decode($rawmarc);
306 # now, find the relevant itemnumber
307 my ($itemnumberfield,$itemnumbersubfield) = MARCfind_marc_from_kohafield($dbh,'items.itemnumber',$frameworkcode);
308 # prepare the new item record
309 my $itemrecord = MARC::Record->new();
310 # parse all fields fields from the complete record
311 foreach ($record->field($itemnumberfield)) {
312 # when the item field is found, save it
313 if ($_->subfield($itemnumbersubfield) == $itemnumber) {
314 $itemrecord->append_fields($_);
321 =head2 sub find_biblioitemnumber($dbh,$biblionumber);
325 Returns the 1st biblioitemnumber related to $biblionumber. When MARC=ON we should have 1 biblionumber = 1 and only 1 biblioitemnumber
326 This sub is useless when MARC=OFF
331 sub find_biblioitemnumber {
332 my ( $dbh, $biblionumber ) = @_;
333 my $sth = $dbh->prepare("select biblioitemnumber from biblioitems where biblionumber=?");
334 $sth->execute($biblionumber);
335 my ($biblioitemnumber) = $sth->fetchrow;
336 return $biblioitemnumber;
339 =head2 $frameworkcode = MARCfind_frameworkcode($dbh,$biblionumber);
343 returns the framework of a given biblio
349 sub MARCfind_frameworkcode {
350 my ( $dbh, $biblionumber ) = @_;
351 my $sth = $dbh->prepare("select frameworkcode from biblio where biblionumber=?");
352 $sth->execute($biblionumber);
353 my ($frameworkcode) = $sth->fetchrow;
354 return $frameworkcode;
357 =head2 $MARCRecord = &MARCkoha2marcBiblio($dbh,$bibliohash);
361 MARCkoha2marcBiblio is a wrapper between old-DB and MARC-DB. It returns a MARC::Record builded with old-DB biblio/biblioitem :
362 all entries of the hash are transformed into their matching MARC field/subfield.
368 sub MARCkoha2marcBiblio {
370 # this function builds partial MARC::Record from the old koha-DB fields
371 my ( $dbh, $bibliohash ) = @_;
372 # we don't have biblio entries in the hash, so we add them first
373 my $sth = $dbh->prepare("select * from biblio where biblionumber=?");
374 $sth->execute($bibliohash->{biblionumber});
375 my $biblio = $sth->fetchrow_hashref;
376 foreach (keys %$biblio) {
377 $bibliohash->{$_}=$biblio->{$_};
379 $sth = $dbh->prepare("select tagfield,tagsubfield from marc_subfield_structure where frameworkcode=? and kohafield=?");
380 my $record = MARC::Record->new();
381 foreach ( keys %$bibliohash ) {
382 &MARCkoha2marcOnefield( $sth, $record, "biblio." . $_, $bibliohash->{$_}, '') if $bibliohash->{$_};
383 &MARCkoha2marcOnefield( $sth, $record, "biblioitems." . $_, $bibliohash->{$_}, '') if $bibliohash->{$_};
386 # other fields => additional authors, subjects, subtitles
387 my $sth2 = $dbh->prepare(" SELECT author FROM additionalauthors WHERE biblionumber=?");
388 $sth2->execute($bibliohash->{biblionumber});
389 while ( my $row = $sth2->fetchrow_hashref ) {
390 &MARCkoha2marcOnefield( $sth, $record, "additionalauthors.author", $bibliohash->{'author'},'' );
392 $sth2 = $dbh->prepare(" SELECT subject FROM bibliosubject WHERE biblionumber=?");
393 $sth2->execute($bibliohash->{biblionumber});
394 while ( my $row = $sth2->fetchrow_hashref ) {
395 &MARCkoha2marcOnefield( $sth, $record, "bibliosubject.subject", $row->{'subject'},'' );
397 $sth2 = $dbh->prepare(" SELECT subtitle FROM bibliosubtitle WHERE biblionumber=?");
398 $sth2->execute($bibliohash->{biblionumber});
399 while ( my $row = $sth2->fetchrow_hashref ) {
400 &MARCkoha2marcOnefield( $sth, $record, "bibliosubtitle.subtitle", $row->{'subtitle'},'' );
406 =head2 $MARCRecord = &MARCkoha2marcItem($dbh,$biblionumber,itemnumber);
408 MARCkoha2marcItem is a wrapper between old-DB and MARC-DB. It returns a MARC::Record builded with old-DB items :
409 all entries of the hash are transformed into their matching MARC field/subfield.
417 sub MARCkoha2marcItem {
419 # this function builds partial MARC::Record from the old koha-DB fields
420 my ( $dbh, $item ) = @_;
422 # my $dbh=&C4Connect;
423 my $sth = $dbh->prepare("select tagfield,tagsubfield from marc_subfield_structure where frameworkcode=? and kohafield=?");
424 my $record = MARC::Record->new();
426 foreach( keys %$item ) {
428 &MARCkoha2marcOnefield( $sth, $record, "items." . $_,
435 =head2 MARCkoha2marcOnefield
439 This sub is for internal use only, used by koha2marcBiblio & koha2marcItem
445 sub MARCkoha2marcOnefield {
446 my ( $sth, $record, $kohafieldname, $value,$frameworkcode ) = @_;
449 $sth->execute($frameworkcode,$kohafieldname);
450 if ( ( $tagfield, $tagsubfield ) = $sth->fetchrow ) {
451 if ( $record->field($tagfield) ) {
452 my $tag = $record->field($tagfield);
454 $tag->add_subfields( $tagsubfield, $value );
455 $record->delete_field($tag);
456 $record->add_fields($tag);
460 $record->add_fields( $tagfield, " ", " ", $tagsubfield => $value );
466 =head2 $MARCrecord = MARChtml2marc($dbh,$rtags,$rsubfields,$rvalues,%indicators);
470 transforms the parameters (coming from HTML form) into a MARC::Record
471 parameters with r are references to arrays.
473 FIXME : should be improved for 3.0, to avoid having 4 differents arrays
480 my ($dbh,$rtags,$rsubfields,$rvalues,%indicators) = @_;
482 my $record = MARC::Record->new();
483 # my %subfieldlist=();
484 my $prevvalue; # if tag <10
485 my $field; # if tag >=10
486 for (my $i=0; $i< @$rtags; $i++) {
487 next unless @$rvalues[$i];
488 # rebuild MARC::Record
489 # warn "0=>".@$rtags[$i].@$rsubfields[$i]." = ".@$rvalues[$i].": ";
490 if (@$rtags[$i] ne $prevtag) {
493 if ($prevtag ne '000') {
494 $record->add_fields((sprintf "%03s",$prevtag),$prevvalue);
496 $record->leader($prevvalue);
501 $record->add_fields($field);
504 $indicators{@$rtags[$i]}.=' ';
505 if (@$rtags[$i] <10) {
506 $prevvalue= @$rvalues[$i];
510 $field = MARC::Field->new( (sprintf "%03s",@$rtags[$i]), substr($indicators{@$rtags[$i]},0,1),substr($indicators{@$rtags[$i]},1,1), @$rsubfields[$i] => @$rvalues[$i]);
511 # warn "1=>".@$rtags[$i].@$rsubfields[$i]." = ".@$rvalues[$i].": ".$field->as_formatted;
513 $prevtag = @$rtags[$i];
515 if (@$rtags[$i] <10) {
516 $prevvalue=@$rvalues[$i];
518 if (length(@$rvalues[$i])>0) {
519 $field->add_subfields(@$rsubfields[$i] => @$rvalues[$i]);
520 # warn "2=>".@$rtags[$i].@$rsubfields[$i]." = ".@$rvalues[$i].": ".$field->as_formatted;
523 $prevtag= @$rtags[$i];
526 # the last has not been included inside the loop... do it now !
527 $record->add_fields($field) if $field;
528 # warn "HTML2MARC=".$record->as_formatted;
533 =head2 $hash = &MARCmarc2koha($dbh,$MARCRecord);
537 builds a hash with old-db datas from a MARC::Record
544 my ($dbh,$record,$frameworkcode) = @_;
545 my $sth=$dbh->prepare("select tagfield,tagsubfield from marc_subfield_structure where frameworkcode=? and kohafield=?");
547 my $sth2=$dbh->prepare("SHOW COLUMNS from biblio");
550 while (($field)=$sth2->fetchrow) {
551 # warn "biblio.".$field;
552 $result=&MARCmarc2kohaOneField($sth,"biblio",$field,$record,$result,$frameworkcode);
554 $sth2=$dbh->prepare("SHOW COLUMNS from biblioitems");
556 while (($field)=$sth2->fetchrow) {
557 if ($field eq 'notes') { $field = 'bnotes'; }
558 # warn "biblioitems".$field;
559 $result=&MARCmarc2kohaOneField($sth,"biblioitems",$field,$record,$result,$frameworkcode);
561 $sth2=$dbh->prepare("SHOW COLUMNS from items");
563 while (($field)=$sth2->fetchrow) {
564 # warn "items".$field;
565 $result=&MARCmarc2kohaOneField($sth,"items",$field,$record,$result,$frameworkcode);
567 # additional authors : specific
568 $result = &MARCmarc2kohaOneField($sth,"bibliosubtitle","subtitle",$record,$result,$frameworkcode);
569 $result = &MARCmarc2kohaOneField($sth,"additionalauthors","additionalauthors",$record,$result,$frameworkcode);
570 # modify copyrightdate to keep only the 1st year found
571 my $temp = $result->{'copyrightdate'};
573 $temp =~ m/c(\d\d\d\d)/; # search cYYYY first
575 $result->{'copyrightdate'} = $1;
576 } else { # if no cYYYY, get the 1st date.
577 $temp =~ m/(\d\d\d\d)/;
578 $result->{'copyrightdate'} = $1;
581 # modify publicationyear to keep only the 1st year found
582 $temp = $result->{'publicationyear'};
583 $temp =~ m/c(\d\d\d\d)/; # search cYYYY first
585 $result->{'publicationyear'} = $1;
586 } else { # if no cYYYY, get the 1st date.
587 $temp =~ m/(\d\d\d\d)/;
588 $result->{'publicationyear'} = $1;
593 sub MARCmarc2kohaOneField {
595 # FIXME ? if a field has a repeatable subfield that is used in old-db, only the 1st will be retrieved...
596 my ( $sth, $kohatable, $kohafield, $record, $result,$frameworkcode ) = @_;
597 # warn "kohatable / $kohafield / $result / ";
601 ( $tagfield, $subfield ) = MARCfind_marc_from_kohafield("",$kohatable.".".$kohafield,$frameworkcode);
602 foreach my $field ( $record->field($tagfield) ) {
603 if ($field->tag()<10) {
604 if ($result->{$kohafield}) {
605 # Reverse array filled with elements from repeated subfields
606 # from first to last to avoid last to first concatenation of
607 # elements in Koha DB. -- thd.
608 $result->{$kohafield} .= " | ".reverse($field->data());
610 $result->{$kohafield} = $field->data();
613 if ( $field->subfields ) {
614 my @subfields = $field->subfields();
615 foreach my $subfieldcount ( 0 .. $#subfields ) {
616 if ($subfields[$subfieldcount][0] eq $subfield) {
617 if ( $result->{$kohafield} ) {
618 $result->{$kohafield} .= " | " . $subfields[$subfieldcount][1];
621 $result->{$kohafield} = $subfields[$subfieldcount][1];
628 # warn "OneField for $kohatable.$kohafield and $frameworkcode=> $tagfield, $subfield";
632 =head2 ($biblionumber,$biblioitemnumber) = NEWnewbibilio($dbh,$MARCRecord,$frameworkcode);
636 creates a biblio from a MARC::Record.
643 my ( $dbh, $record, $frameworkcode ) = @_;
645 my $biblioitemnumber;
646 my $olddata = MARCmarc2koha( $dbh, $record,$frameworkcode );
647 $olddata->{frameworkcode} = $frameworkcode;
648 $biblionumber = REALnewbiblio( $dbh, $olddata );
649 $olddata->{biblionumber} = $biblionumber;
650 # add biblionumber into the MARC record (it's the ID for zebra)
651 my ( $tagfield, $tagsubfield ) =
652 MARCfind_marc_from_kohafield( $dbh, "biblio.biblionumber",$frameworkcode );
656 $newfield = MARC::Field->new(
657 $tagfield, $biblionumber,
660 $newfield = MARC::Field->new(
661 $tagfield, '', '', "$tagsubfield" => $biblionumber,
664 # drop old field (just in case it already exist and create new one...
665 my $old_field = $record->field($tagfield);
666 $record->delete_field($old_field);
667 $record->add_fields($newfield);
669 #create the marc entry, that stores the rax marc record in Koha 3.0
670 $olddata->{marc} = $record->as_usmarc();
671 $olddata->{marcxml} = $record->as_xml();
672 # and create biblioitem, that's all folks !
673 $biblioitemnumber = REALnewbiblioitem( $dbh, $olddata );
675 # search subtiles, addiauthors and subjects
676 ( $tagfield, $tagsubfield ) =
677 MARCfind_marc_from_kohafield( $dbh, "additionalauthors.author",$frameworkcode );
678 my @addiauthfields = $record->field($tagfield);
679 foreach my $addiauthfield (@addiauthfields) {
680 my @addiauthsubfields = $addiauthfield->subfield($tagsubfield);
681 foreach my $subfieldcount ( 0 .. $#addiauthsubfields ) {
682 REALmodaddauthor( $dbh, $biblionumber,
683 $addiauthsubfields[$subfieldcount] );
686 ( $tagfield, $tagsubfield ) =
687 MARCfind_marc_from_kohafield( $dbh, "bibliosubtitle.subtitle",$frameworkcode );
688 my @subtitlefields = $record->field($tagfield);
689 foreach my $subtitlefield (@subtitlefields) {
690 my @subtitlesubfields = $subtitlefield->subfield($tagsubfield);
691 foreach my $subfieldcount ( 0 .. $#subtitlesubfields ) {
692 REALnewsubtitle( $dbh, $biblionumber,
693 $subtitlesubfields[$subfieldcount] );
696 ( $tagfield, $tagsubfield ) =
697 MARCfind_marc_from_kohafield( $dbh, "bibliosubject.subject",$frameworkcode );
698 my @subj = $record->field($tagfield);
700 foreach my $subject (@subj) {
701 my @subjsubfield = $subject->subfield($tagsubfield);
702 foreach my $subfieldcount ( 0 .. $#subjsubfield ) {
703 push @subjects, $subjsubfield[$subfieldcount];
706 REALmodsubject( $dbh, $biblionumber, 1, @subjects );
707 return ( $biblionumber, $biblioitemnumber );
710 =head2 NEWmodbilbioframework($dbh,$biblionumber,$frameworkcode);
714 modify the framework of a biblio
720 sub NEWmodbiblioframework {
721 my ($dbh,$biblionumber,$frameworkcode) =@_;
722 my $sth = $dbh->prepare("Update biblio SET frameworkcode=? WHERE biblionumber=?");
723 $sth->execute($frameworkcode,$biblionumber);
727 =head2 NEWmodbiblio($dbh,$MARCrecord,$biblionumber,$frameworkcode);
731 modify a biblio (MARC=ON)
738 my ($dbh,$record,$biblionumber,$frameworkcode) =@_;
739 $frameworkcode="" unless $frameworkcode;
740 # &MARCmodbiblio($dbh,$bibid,$record,$frameworkcode,0);
741 my $oldbiblio = MARCmarc2koha($dbh,$record,$frameworkcode);
743 $oldbiblio->{frameworkcode} = $frameworkcode;
744 #create the marc entry, that stores the rax marc record in Koha 3.0
745 $oldbiblio->{marc} = $record->as_usmarc();
746 $oldbiblio->{marcxml} = $record->as_xml();
748 REALmodbiblio($dbh,$oldbiblio);
749 REALmodbiblioitem($dbh,$oldbiblio);
750 # now, modify addi authors, subject, addititles.
751 my ($tagfield,$tagsubfield) = MARCfind_marc_from_kohafield($dbh,"additionalauthors.author",$frameworkcode);
752 my @addiauthfields = $record->field($tagfield);
753 foreach my $addiauthfield (@addiauthfields) {
754 my @addiauthsubfields = $addiauthfield->subfield($tagsubfield);
755 foreach my $subfieldcount (0..$#addiauthsubfields) {
756 REALmodaddauthor($dbh,$biblionumber,$addiauthsubfields[$subfieldcount]);
759 ($tagfield,$tagsubfield) = MARCfind_marc_from_kohafield($dbh,"bibliosubtitle.subtitle",$frameworkcode);
760 my @subtitlefields = $record->field($tagfield);
761 foreach my $subtitlefield (@subtitlefields) {
762 my @subtitlesubfields = $subtitlefield->subfield($tagsubfield);
763 # delete & create subtitle again because REALmodsubtitle can't handle new subtitles
765 $dbh->do("delete from bibliosubtitle where biblionumber=$biblionumber");
766 foreach my $subfieldcount (0..$#subtitlesubfields) {
767 foreach my $subtit(split /\||#/,$subtitlesubfields[$subfieldcount]) {
768 REALnewsubtitle($dbh,$biblionumber,$subtit);
772 ($tagfield,$tagsubfield) = MARCfind_marc_from_kohafield($dbh,"bibliosubject.subject",$frameworkcode);
773 my @subj = $record->field($tagfield);
775 foreach my $subject (@subj) {
776 my @subjsubfield = $subject->subfield($tagsubfield);
777 foreach my $subfieldcount (0..$#subjsubfield) {
778 push @subjects,$subjsubfield[$subfieldcount];
781 REALmodsubject($dbh,$biblionumber,1,@subjects);
785 =head2 NEWmodbilbioframework($dbh,$biblionumber,$frameworkcode);
796 my ( $dbh, $bibid ) = @_;
797 my $biblio = &MARCfind_oldbiblionumber_from_MARCbibid( $dbh, $bibid );
798 &REALdelbiblio( $dbh, $biblio );
801 "select biblioitemnumber from biblioitems where biblionumber=?");
802 $sth->execute($biblio);
803 while ( my ($biblioitemnumber) = $sth->fetchrow ) {
804 REALdelbiblioitem( $dbh, $biblioitemnumber );
806 &MARCdelbiblio( $dbh, $bibid, 0 );
809 =head2 $itemnumber = NEWnewitem($dbh, $record, $biblionumber, $biblioitemnumber);
813 creates an item from a MARC::Record
820 my ( $dbh, $record, $biblionumber, $biblioitemnumber ) = @_;
823 my $frameworkcode=MARCfind_frameworkcode($dbh,$biblionumber);
824 my $item = &MARCmarc2koha( $dbh, $record,$frameworkcode );
825 # needs old biblionumber and biblioitemnumber
826 $item->{'biblionumber'} = $biblionumber;
827 $item->{'biblioitemnumber'}=$biblioitemnumber;
828 $item->{marc} = $record->as_usmarc();
829 my ( $itemnumber, $error ) = &REALnewitems( $dbh, $item, $item->{barcode} );
834 =head2 $itemnumber = NEWmoditem($dbh, $record, $biblionumber, $biblioitemnumber,$itemnumber);
845 my ( $dbh, $record, $biblionumber, $biblioitemnumber, $itemnumber) = @_;
847 my $frameworkcode=MARCfind_frameworkcode($dbh,$biblionumber);
848 my $olditem = MARCmarc2koha( $dbh, $record,$frameworkcode );
850 $olditem->{marc} = $record->as_usmarc();
851 $olditem->{biblionumber} = $biblionumber;
852 $olditem->{biblioitemnumber} = $biblioitemnumber;
854 REALmoditem( $dbh, $olditem );
858 =head2 $itemnumber = NEWdelitem($dbh, $biblionumber, $biblioitemnumber, $itemnumber);
869 my ( $dbh, $bibid, $itemnumber ) = @_;
870 my $biblio = &MARCfind_oldbiblionumber_from_MARCbibid( $dbh, $bibid );
871 &REALdelitem( $dbh, $itemnumber );
872 &MARCdelitem( $dbh, $bibid, $itemnumber );
876 =head2 $biblionumber = REALnewbiblio($dbh,$biblio);
880 adds a record in biblio table. Datas are in the hash $biblio.
887 my ( $dbh, $biblio ) = @_;
889 $dbh->do('lock tables biblio WRITE');
890 my $sth = $dbh->prepare("Select max(biblionumber) from biblio");
892 my $data = $sth->fetchrow_arrayref;
893 my $bibnum = $$data[0] + 1;
896 if ( $biblio->{'seriestitle'} ) { $series = 1 }
899 $dbh->prepare("insert into biblio set biblionumber=?, title=?, author=?, copyrightdate=?,
900 serial=?, seriestitle=?, notes=?, abstract=?,
904 $bibnum, $biblio->{'title'},
905 $biblio->{'author'}, $biblio->{'copyrightdate'},
906 $biblio->{'serial'}, $biblio->{'seriestitle'},
907 $biblio->{'notes'}, $biblio->{'abstract'},
908 $biblio->{'unititle'}
912 $dbh->do('unlock tables');
916 =head2 $biblionumber = REALmodbiblio($dbh,$biblio);
920 modify a record in biblio table. Datas are in the hash $biblio.
927 my ( $dbh, $biblio ) = @_;
928 my $sth = $dbh->prepare("Update biblio set title=?, author=?, abstract=?, copyrightdate=?,
929 seriestitle=?, serial=?, unititle=?, notes=?, frameworkcode=?
930 where biblionumber = ?"
933 $biblio->{'title'}, $biblio->{'author'},
934 $biblio->{'abstract'}, $biblio->{'copyrightdate'},
935 $biblio->{'seriestitle'}, $biblio->{'serial'},
936 $biblio->{'unititle'}, $biblio->{'notes'},
937 $biblio->{frameworkcode},
938 $biblio->{'biblionumber'}
941 return ( $biblio->{'biblionumber'} );
944 =head2 REALmodsubtitle($dbh,$bibnum,$subtitle);
948 modify subtitles in bibliosubtitle table.
954 sub REALmodsubtitle {
955 my ( $dbh, $bibnum, $subtitle ) = @_;
958 "update bibliosubtitle set subtitle = ? where biblionumber = ?");
959 $sth->execute( $subtitle, $bibnum );
963 =head2 REALmodaddauthor($dbh,$bibnum,$author);
967 adds or modify additional authors
968 NOTE : Strange sub : seems to delete MANY and add only ONE author... maybe buggy ?
974 sub REALmodaddauthor {
975 my ( $dbh, $bibnum, @authors ) = @_;
977 # my $dbh = C4Connect;
979 $dbh->prepare("Delete from additionalauthors where biblionumber = ?");
981 $sth->execute($bibnum);
983 foreach my $author (@authors) {
984 if ( $author ne '' ) {
987 "Insert into additionalauthors set author = ?, biblionumber = ?"
990 $sth->execute( $author, $bibnum );
997 =head2 $errors = REALmodsubject($dbh,$bibnum, $force, @subject);
1001 modify/adds subjects
1006 sub REALmodsubject {
1007 my ( $dbh, $bibnum, $force, @subject ) = @_;
1009 # my $dbh = C4Connect;
1010 my $count = @subject;
1012 for ( my $i = 0 ; $i < $count ; $i++ ) {
1013 $subject[$i] =~ s/^ //g;
1014 $subject[$i] =~ s/ $//g;
1017 "select * from catalogueentry where entrytype = 's' and catalogueentry = ?"
1019 $sth->execute( $subject[$i] );
1021 if ( my $data = $sth->fetchrow_hashref ) {
1024 if ( $force eq $subject[$i] || $force == 1 ) {
1026 # subject not in aut, chosen to force anway
1027 # so insert into cataloguentry so its in auth file
1030 "Insert into catalogueentry (entrytype,catalogueentry) values ('s',?)"
1033 $sth2->execute( $subject[$i] ) if ( $subject[$i] );
1038 "$subject[$i]\n does not exist in the subject authority file";
1041 "Select * from catalogueentry where entrytype = 's' and (catalogueentry like ? or catalogueentry like ? or catalogueentry like ?)"
1043 $sth2->execute( "$subject[$i] %", "% $subject[$i] %",
1045 while ( my $data = $sth2->fetchrow_hashref ) {
1046 $error .= "<br>$data->{'catalogueentry'}";
1055 $dbh->prepare("Delete from bibliosubject where biblionumber = ?");
1056 $sth->execute($bibnum);
1060 "Insert into bibliosubject (subject,biblionumber) values (?,?)");
1062 foreach $query (@subject) {
1063 $sth->execute( $query, $bibnum ) if ( $query && $bibnum );
1072 =head2 REALmodbiblioitem($dbh, $biblioitem);
1081 sub REALmodbiblioitem {
1082 my ( $dbh, $biblioitem ) = @_;
1085 my $sth = $dbh->prepare("update biblioitems set number=?,volume=?, volumedate=?, lccn=?,
1086 itemtype=?, url=?, isbn=?, issn=?,
1087 publishercode=?, publicationyear=?, classification=?, dewey=?,
1088 subclass=?, illus=?, pages=?, volumeddesc=?,
1089 notes=?, size=?, place=?, marc=?,
1091 where biblioitemnumber=?");
1092 $sth->execute( $biblioitem->{number}, $biblioitem->{volume}, $biblioitem->{volumedate}, $biblioitem->{lccn},
1093 $biblioitem->{itemtype}, $biblioitem->{url}, $biblioitem->{isbn}, $biblioitem->{issn},
1094 $biblioitem->{publishercode}, $biblioitem->{publicationyear}, $biblioitem->{classification}, $biblioitem->{dewey},
1095 $biblioitem->{subclass}, $biblioitem->{illus}, $biblioitem->{pages}, $biblioitem->{volumeddesc},
1096 $biblioitem->{bnotes}, $biblioitem->{size}, $biblioitem->{place}, $biblioitem->{marc},
1097 $biblioitem->{marcxml}, $biblioitem->{biblioitemnumber});
1098 my $record = MARC::File::USMARC::decode($biblioitem->{marc});
1099 zebra_create($biblioitem->{biblionumber}, $record);
1100 # warn "MOD : $biblioitem->{biblioitemnumber} = ".$biblioitem->{marc};
1103 =head2 REALnewbiblioitem($dbh,$biblioitem);
1107 adds a biblioitem ($biblioitem is a hash with the values)
1113 sub REALnewbiblioitem {
1114 my ( $dbh, $biblioitem ) = @_;
1116 $dbh->do("lock tables biblioitems WRITE, biblio WRITE, marc_subfield_structure READ");
1117 my $sth = $dbh->prepare("Select max(biblioitemnumber) from biblioitems");
1119 my $biblioitemnumber;
1122 $data = $sth->fetchrow_arrayref;
1123 $biblioitemnumber = $$data[0] + 1;
1125 # Insert biblioitemnumber in MARC record, we need it to manage items later...
1126 my $frameworkcode=MARCfind_frameworkcode($dbh,$biblioitem->{biblionumber});
1127 my ($biblioitemnumberfield,$biblioitemnumbersubfield) = MARCfind_marc_from_kohafield($dbh,'biblioitems.biblioitemnumber',$frameworkcode);
1128 my $record = MARC::File::USMARC::decode($biblioitem->{marc});
1129 my $field=$record->field($biblioitemnumberfield);
1130 $field->update($biblioitemnumbersubfield => "$biblioitemnumber");
1131 $biblioitem->{marc} = $record->as_usmarc();
1132 $biblioitem->{marcxml} = $record->as_xml();
1134 $sth = $dbh->prepare( "insert into biblioitems set
1135 biblioitemnumber = ?, biblionumber = ?,
1136 volume = ?, number = ?,
1137 classification = ?, itemtype = ?,
1139 issn = ?, dewey = ?,
1140 subclass = ?, publicationyear = ?,
1141 publishercode = ?, volumedate = ?,
1142 volumeddesc = ?, illus = ?,
1143 pages = ?, notes = ?,
1145 marc = ?, place = ?,
1149 $biblioitemnumber, $biblioitem->{'biblionumber'},
1150 $biblioitem->{'volume'}, $biblioitem->{'number'},
1151 $biblioitem->{'classification'}, $biblioitem->{'itemtype'},
1152 $biblioitem->{'url'}, $biblioitem->{'isbn'},
1153 $biblioitem->{'issn'}, $biblioitem->{'dewey'},
1154 $biblioitem->{'subclass'}, $biblioitem->{'publicationyear'},
1155 $biblioitem->{'publishercode'}, $biblioitem->{'volumedate'},
1156 $biblioitem->{'volumeddesc'}, $biblioitem->{'illus'},
1157 $biblioitem->{'pages'}, $biblioitem->{'bnotes'},
1158 $biblioitem->{'size'}, $biblioitem->{'lccn'},
1159 $biblioitem->{'marc'}, $biblioitem->{'place'},
1160 $biblioitem->{marcxml},
1162 $dbh->do("unlock tables");
1163 zebra_create($biblioitem->{biblionumber}, $record);
1164 return ($biblioitemnumber);
1167 =head2 REALnewsubtitle($dbh,$bibnum,$subtitle);
1171 create a new subtitle
1176 sub REALnewsubtitle {
1177 my ( $dbh, $bibnum, $subtitle ) = @_;
1180 "insert into bibliosubtitle set biblionumber = ?, subtitle = ?");
1181 $sth->execute( $bibnum, $subtitle ) if $subtitle;
1185 =head2 ($itemnumber,$errors)= REALnewitems($dbh,$item,$barcode);
1189 create a item. $item is a hash and $barcode the barcode.
1196 my ( $dbh, $item, $barcode ) = @_;
1198 # warn "OLDNEWITEMS";
1200 $dbh->do('lock tables items WRITE, biblio WRITE,biblioitems WRITE,marc_subfield_structure WRITE');
1201 my $sth = $dbh->prepare("Select max(itemnumber) from items");
1206 $data = $sth->fetchrow_hashref;
1207 $itemnumber = $data->{'max(itemnumber)'} + 1;
1209 # FIXME the "notforloan" field seems to be named "loan" in some places. workaround bugfix.
1210 if ( $item->{'loan'} ) {
1211 $item->{'notforloan'} = $item->{'loan'};
1214 # if dateaccessioned is provided, use it. Otherwise, set to NOW()
1215 if ( $item->{'dateaccessioned'} ) {
1216 $sth = $dbh->prepare( "Insert into items set
1217 itemnumber = ?, biblionumber = ?,
1218 multivolumepart = ?,
1219 biblioitemnumber = ?, barcode = ?,
1220 booksellerid = ?, dateaccessioned = ?,
1221 homebranch = ?, holdingbranch = ?,
1222 price = ?, replacementprice = ?,
1223 replacementpricedate = NOW(), datelastseen = NOW(),
1224 multivolume = ?, stack = ?,
1225 itemlost = ?, wthdrawn = ?,
1226 paidfor = ?, itemnotes = ?,
1227 itemcallnumber =?, notforloan = ?,
1232 $itemnumber, $item->{'biblionumber'},
1233 $item->{'multivolumepart'},
1234 $item->{'biblioitemnumber'},$item->{barcode},
1235 $item->{'booksellerid'}, $item->{'dateaccessioned'},
1236 $item->{'homebranch'}, $item->{'holdingbranch'},
1237 $item->{'price'}, $item->{'replacementprice'},
1238 $item->{multivolume}, $item->{stack},
1239 $item->{itemlost}, $item->{wthdrawn},
1240 $item->{paidfor}, $item->{'itemnotes'},
1241 $item->{'itemcallnumber'}, $item->{'notforloan'},
1244 if ( defined $sth->errstr ) {
1245 $error .= $sth->errstr;
1249 $sth = $dbh->prepare( "Insert into items set
1250 itemnumber = ?, biblionumber = ?,
1251 multivolumepart = ?,
1252 biblioitemnumber = ?, barcode = ?,
1253 booksellerid = ?, dateaccessioned = NOW(),
1254 homebranch = ?, holdingbranch = ?,
1255 price = ?, replacementprice = ?,
1256 replacementpricedate = NOW(), datelastseen = NOW(),
1257 multivolume = ?, stack = ?,
1258 itemlost = ?, wthdrawn = ?,
1259 paidfor = ?, itemnotes = ?,
1260 itemcallnumber =?, notforloan = ?,
1265 $itemnumber, $item->{'biblionumber'},
1266 $item->{'multivolumepart'},
1267 $item->{'biblioitemnumber'},$item->{barcode},
1268 $item->{'booksellerid'},
1269 $item->{'homebranch'}, $item->{'holdingbranch'},
1270 $item->{'price'}, $item->{'replacementprice'},
1271 $item->{multivolume}, $item->{stack},
1272 $item->{itemlost}, $item->{wthdrawn},
1273 $item->{paidfor}, $item->{'itemnotes'},
1274 $item->{'itemcallnumber'}, $item->{'notforloan'},
1277 if ( defined $sth->errstr ) {
1278 $error .= $sth->errstr;
1281 # item stored, now, deal with the marc part...
1282 $sth = $dbh->prepare("select biblioitems.marc,biblio.frameworkcode from biblioitems,biblio
1283 where biblio.biblionumber=biblioitems.biblionumber and
1284 biblio.biblionumber=?");
1285 $sth->execute($item->{biblionumber});
1286 if ( defined $sth->errstr ) {
1287 $error .= $sth->errstr;
1289 my ($rawmarc,$frameworkcode) = $sth->fetchrow;
1290 warn "ERROR IN REALnewitem, MARC record not found FOR $item->{biblionumber} => $rawmarc <=" unless $rawmarc;
1291 my $record = MARC::File::USMARC::decode($rawmarc);
1292 # ok, we have the marc record, add item number to the item field (in {marc}, and add the field to the record)
1293 my ($itemnumberfield,$itemnumbersubfield) = MARCfind_marc_from_kohafield($dbh,'items.itemnumber',$frameworkcode);
1294 my $itemrecord = MARC::File::USMARC::decode($item->{marc});
1295 my $itemfield = $itemrecord->field($itemnumberfield);
1296 $itemfield->add_subfields($itemnumbersubfield => "$itemnumber");
1297 $record->insert_grouped_field($itemfield);
1298 # save the record into biblioitem
1299 $sth=$dbh->prepare("update biblioitems set marc=?,marcxml=? where biblionumber=?");
1300 $sth->execute($record->as_usmarc(),$record->as_xml(),$item->{biblionumber});
1301 if ( defined $sth->errstr ) {
1302 $error .= $sth->errstr;
1304 zebra_create($item->{biblionumber},$record);
1305 $dbh->do('unlock tables');
1306 return ( $itemnumber, $error );
1309 =head2 REALmoditem($dbh,$item);
1320 my ( $dbh, $item ) = @_;
1322 $dbh->do('lock tables items WRITE, biblio WRITE,biblioitems WRITE');
1323 $item->{'itemnum'} = $item->{'itemnumber'} unless $item->{'itemnum'};
1324 my $query = "update items set barcode=?,itemnotes=?,itemcallnumber=?,notforloan=?,location=?,multivolumepart=?,multivolume=?,stack=?,wthdrawn=?";
1326 $item->{'barcode'}, $item->{'notes'},
1327 $item->{'itemcallnumber'}, $item->{'notforloan'},
1328 $item->{'location'}, $item->{multivolumepart},
1329 $item->{multivolume}, $item->{stack},
1332 if ( $item->{'lost'} ne '' ) {
1333 $query = "update items set biblioitemnumber=?,barcode=?,itemnotes=?,homebranch=?,
1334 itemlost=?,wthdrawn=?,itemcallnumber=?,notforloan=?,
1335 location=?,multivolumepart=?,multivolume=?,stack=?,wthdrawn=?";
1337 $item->{'bibitemnum'}, $item->{'barcode'},
1338 $item->{'notes'}, $item->{'homebranch'},
1339 $item->{'lost'}, $item->{'wthdrawn'},
1340 $item->{'itemcallnumber'}, $item->{'notforloan'},
1341 $item->{'location'}, $item->{multivolumepart},
1342 $item->{multivolume}, $item->{stack},
1345 if ($item->{homebranch}) {
1346 $query.=",homebranch=?";
1347 push @bind, $item->{homebranch};
1349 if ($item->{holdingbranch}) {
1350 $query.=",holdingbranch=?";
1351 push @bind, $item->{holdingbranch};
1354 $query.=" where itemnumber=?";
1355 push @bind,$item->{'itemnum'};
1356 if ( $item->{'replacement'} ne '' ) {
1357 $query =~ s/ where/,replacementprice='$item->{'replacement'}' where/;
1359 my $sth = $dbh->prepare($query);
1360 $sth->execute(@bind);
1362 # item stored, now, deal with the marc part...
1363 $sth = $dbh->prepare("select biblioitems.marc,biblio.frameworkcode from biblioitems,biblio
1364 where biblio.biblionumber=biblioitems.biblionumber and
1365 biblio.biblionumber=? and
1366 biblioitems.biblioitemnumber=?");
1367 $sth->execute($item->{biblionumber},$item->{biblioitemnumber});
1368 if ( defined $sth->errstr ) {
1369 $error .= $sth->errstr;
1371 my ($rawmarc,$frameworkcode) = $sth->fetchrow;
1372 warn "ERROR IN REALmoditem, MARC record not found" unless $rawmarc;
1373 my $record = MARC::File::USMARC::decode($rawmarc);
1374 # ok, we have the marc record, find the previous item record for this itemnumber and delete it
1375 my ($itemnumberfield,$itemnumbersubfield) = MARCfind_marc_from_kohafield($dbh,'items.itemnumber',$frameworkcode);
1376 # prepare the new item record
1377 my $itemrecord = MARC::File::USMARC::decode($item->{marc});
1378 my $itemfield = $itemrecord->field($itemnumberfield);
1379 $itemfield->add_subfields($itemnumbersubfield => '$itemnumber');
1380 # parse all fields fields from the complete record
1381 foreach ($record->field($itemnumberfield)) {
1382 # when the previous field is found, replace by the new one
1383 if ($_->subfield($itemnumbersubfield) == $item->{itemnum}) {
1384 $_->replace_with($itemfield);
1387 # $record->insert_grouped_field($itemfield);
1388 # save the record into biblioitem
1389 $sth=$dbh->prepare("update biblioitems set marc=?,marcxml=? where biblionumber=? and biblioitemnumber=?");
1390 $sth->execute($record->as_usmarc(),$record->as_xml(),$item->{biblionumber},$item->{biblioitemnumber});
1391 zebra_create($item->biblionumber,$record);
1392 if ( defined $sth->errstr ) {
1393 $error .= $sth->errstr;
1395 $dbh->do('unlock tables');
1400 =head2 REALdelitem($dbh,$itemnum);
1411 my ( $dbh, $itemnum ) = @_;
1413 # my $dbh=C4Connect;
1414 my $sth = $dbh->prepare("select * from items where itemnumber=?");
1415 $sth->execute($itemnum);
1416 my $data = $sth->fetchrow_hashref;
1418 my $query = "Insert into deleteditems set ";
1420 foreach my $temp ( keys %$data ) {
1421 $query .= "$temp = ?,";
1422 push ( @bind, $data->{$temp} );
1427 $sth = $dbh->prepare($query);
1428 $sth->execute(@bind);
1430 $sth = $dbh->prepare("Delete from items where itemnumber=?");
1431 $sth->execute($itemnum);
1437 =head2 REALdelbiblioitem($dbh,$biblioitemnumber);
1441 deletes a biblioitem
1442 NOTE : not standard sub name. Should be REALdelbiblioitem()
1448 sub REALdelbiblioitem {
1449 my ( $dbh, $biblioitemnumber ) = @_;
1451 # my $dbh = C4Connect;
1452 my $sth = $dbh->prepare( "Select * from biblioitems
1453 where biblioitemnumber = ?"
1457 $sth->execute($biblioitemnumber);
1459 if ( $results = $sth->fetchrow_hashref ) {
1463 "Insert into deletedbiblioitems (biblioitemnumber, biblionumber, volume, number, classification, itemtype,
1464 isbn, issn ,dewey ,subclass ,publicationyear ,publishercode ,volumedate ,volumeddesc ,timestamp ,illus ,
1465 pages ,notes ,size ,url ,lccn ) values(?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)"
1469 $results->{biblioitemnumber}, $results->{biblionumber},
1470 $results->{volume}, $results->{number},
1471 $results->{classification}, $results->{itemtype},
1472 $results->{isbn}, $results->{issn},
1473 $results->{dewey}, $results->{subclass},
1474 $results->{publicationyear}, $results->{publishercode},
1475 $results->{volumedate}, $results->{volumeddesc},
1476 $results->{timestamp}, $results->{illus},
1477 $results->{pages}, $results->{notes},
1478 $results->{size}, $results->{url},
1482 $dbh->prepare("Delete from biblioitems where biblioitemnumber = ?");
1483 $sth2->execute($biblioitemnumber);
1488 # Now delete all the items attached to the biblioitem
1489 $sth = $dbh->prepare("Select * from items where biblioitemnumber = ?");
1490 $sth->execute($biblioitemnumber);
1492 while ( my $data = $sth->fetchrow_hashref ) {
1493 my $query = "Insert into deleteditems set ";
1495 foreach my $temp ( keys %$data ) {
1496 $query .= "$temp = ?,";
1497 push ( @bind, $data->{$temp} );
1500 my $sth2 = $dbh->prepare($query);
1501 $sth2->execute(@bind);
1504 $sth = $dbh->prepare("Delete from items where biblioitemnumber = ?");
1505 $sth->execute($biblioitemnumber);
1509 } # sub deletebiblioitem
1511 =head2 REALdelbiblio($dbh,$biblio);
1522 my ( $dbh, $biblio ) = @_;
1523 my $sth = $dbh->prepare("select * from biblio where biblionumber=?");
1524 $sth->execute($biblio);
1525 if ( my $data = $sth->fetchrow_hashref ) {
1527 my $query = "Insert into deletedbiblio set ";
1529 foreach my $temp ( keys %$data ) {
1530 $query .= "$temp = ?,";
1531 push ( @bind, $data->{$temp} );
1534 #replacing the last , by ",?)"
1536 $sth = $dbh->prepare($query);
1537 $sth->execute(@bind);
1539 $sth = $dbh->prepare("Delete from biblio where biblionumber=?");
1540 $sth->execute($biblio);
1546 =head2 $number = itemcount($biblio);
1550 returns the number of items attached to a biblio
1558 my $dbh = C4::Context->dbh;
1561 my $sth = $dbh->prepare("Select count(*) from items where biblionumber=?");
1562 $sth->execute($biblio);
1563 my $data = $sth->fetchrow_hashref;
1565 return ( $data->{'count(*)'} );
1568 =head2 $biblionumber = newbiblio($biblio);
1572 create a biblio. The parameter is a hash
1580 my $dbh = C4::Context->dbh;
1581 my $bibnum = REALnewbiblio( $dbh, $biblio );
1582 # finds new (MARC bibid
1583 # my $bibid = &MARCfind_MARCbibid_from_oldbiblionumber($dbh,$bibnum);
1584 # my $record = &MARCkoha2marcBiblio( $dbh, $bibnum );
1585 # MARCaddbiblio( $dbh, $record, $bibnum,'' );
1589 =head2 $biblionumber = &modbiblio($biblio);
1593 Update a biblio record.
1595 C<$biblio> is a reference-to-hash whose keys are the fields in the
1596 biblio table in the Koha database. All fields must be present, not
1597 just the ones you wish to change.
1599 C<&modbiblio> updates the record defined by
1600 C<$biblio-E<gt>{biblionumber}> with the values in C<$biblio>.
1602 C<&modbiblio> returns C<$biblio-E<gt>{biblionumber}> whether it was
1611 my $dbh = C4::Context->dbh;
1612 my $biblionumber=REALmodbiblio($dbh,$biblio);
1613 my $record = MARCkoha2marcBiblio($dbh,$biblionumber,$biblionumber);
1614 # finds new (MARC bibid
1615 my $bibid = &MARCfind_MARCbibid_from_oldbiblionumber($dbh,$biblionumber);
1616 MARCmodbiblio($dbh,$bibid,$record,"",0);
1617 return($biblionumber);
1620 =head2 &modsubtitle($biblionumber, $subtitle);
1624 Sets the subtitle of a book.
1626 C<$biblionumber> is the biblionumber of the book to modify.
1628 C<$subtitle> is the new subtitle.
1635 my ( $bibnum, $subtitle ) = @_;
1636 my $dbh = C4::Context->dbh;
1637 &REALmodsubtitle( $dbh, $bibnum, $subtitle );
1640 =head2 &modaddauthor($biblionumber, $author);
1644 Replaces all additional authors for the book with biblio number
1645 C<$biblionumber> with C<$author>. If C<$author> is the empty string,
1646 C<&modaddauthor> deletes all additional authors.
1653 my ( $bibnum, @authors ) = @_;
1654 my $dbh = C4::Context->dbh;
1655 &REALmodaddauthor( $dbh, $bibnum, @authors );
1656 } # sub modaddauthor
1658 =head2 $error = &modsubject($biblionumber, $force, @subjects);
1662 $force - a subject to force
1663 $error - Error message, or undef if successful.
1670 my ( $bibnum, $force, @subject ) = @_;
1671 my $dbh = C4::Context->dbh;
1672 my $error = &REALmodsubject( $dbh, $bibnum, $force, @subject );
1674 # When MARC is off, ensures that the MARC biblio table gets updated with new
1675 # subjects, of course, it deletes the biblio in marc, and then recreates.
1676 # This check is to ensure that no MARC data exists to lose.
1677 # if (C4::Context->preference("MARC") eq '0'){
1678 # warn "in modSUBJECT";
1679 # my $MARCRecord = &MARCkoha2marcBiblio($dbh,$bibnum);
1680 # my $bibid = &MARCfind_MARCbibid_from_oldbiblionumber($dbh,$bibnum);
1681 # &MARCmodbiblio($dbh,$bibid, $MARCRecord);
1687 =head2 modbibitem($biblioitem);
1691 modify a biblioitem. The parameter is a hash
1698 my ($biblioitem) = @_;
1699 my $dbh = C4::Context->dbh;
1700 &REALmodbiblioitem( $dbh, $biblioitem );
1703 =head2 $biblioitemnumber = newbiblioitem($biblioitem)
1707 create a biblioitem, the parameter is a hash
1714 my ($biblioitem) = @_;
1715 my $dbh = C4::Context->dbh;
1716 # add biblio information to the hash
1717 my $MARCbiblio = MARCkoha2marcBiblio( $dbh, $biblioitem );
1718 $biblioitem->{marc} = $MARCbiblio->as_usmarc();
1719 my $bibitemnum = &REALnewbiblioitem( $dbh, $biblioitem );
1720 return ($bibitemnum);
1723 =head2 newsubtitle($biblionumber,$subtitle);
1727 insert a subtitle for $biblionumber biblio
1735 my ( $bibnum, $subtitle ) = @_;
1736 my $dbh = C4::Context->dbh;
1737 &REALnewsubtitle( $dbh, $bibnum, $subtitle );
1740 =head2 $errors = newitems($item, @barcodes);
1744 insert items ($item is a hash)
1752 my ( $item, @barcodes ) = @_;
1753 my $dbh = C4::Context->dbh;
1757 foreach my $barcode (@barcodes) {
1758 # add items, one by one for each barcode.
1760 $oneitem->{barcode}= $barcode;
1761 my $MARCitem = &MARCkoha2marcItem( $dbh, $oneitem);
1762 $oneitem->{marc} = $MARCitem->as_usmarc;
1763 ( $itemnumber, $error ) = &REALnewitems( $dbh, $oneitem);
1764 # $errors .= $error;
1765 # &MARCadditem( $dbh, $MARCitem, $item->{biblionumber} );
1770 =head2 moditem($item);
1774 modify an item ($item is a hash with all item informations)
1783 my $dbh = C4::Context->dbh;
1784 &REALmoditem( $dbh, $item );
1786 &MARCkoha2marcItem( $dbh, $item->{'biblionumber'}, $item->{'itemnum'} );
1788 &MARCfind_MARCbibid_from_oldbiblionumber( $dbh, $item->{biblionumber} );
1789 &MARCmoditem( $dbh, $MARCitem, $bibid, $item->{itemnum}, 0 );
1792 =head2 $error = checkitems($count,@barcodes);
1796 check for each @barcode entry that the barcode is not a duplicate
1803 my ( $count, @barcodes ) = @_;
1804 my $dbh = C4::Context->dbh;
1806 my $sth = $dbh->prepare("Select * from items where barcode=?");
1807 for ( my $i = 0 ; $i < $count ; $i++ ) {
1808 $barcodes[$i] = uc $barcodes[$i];
1809 $sth->execute( $barcodes[$i] );
1810 if ( my $data = $sth->fetchrow_hashref ) {
1811 $error .= " Duplicate Barcode: $barcodes[$i]";
1818 =head2 $delitem($itemnum);
1822 delete item $itemnum being the item number to delete
1830 my $dbh = C4::Context->dbh;
1831 &REALdelitem( $dbh, $itemnum );
1834 =head2 deletebiblioitem($biblioitemnumber);
1838 delete the biblioitem $biblioitemnumber
1844 sub deletebiblioitem {
1845 my ($biblioitemnumber) = @_;
1846 my $dbh = C4::Context->dbh;
1847 &REALdelbiblioitem( $dbh, $biblioitemnumber );
1848 } # sub deletebiblioitem
1850 =head2 delbiblio($biblionumber)
1854 delete biblio $biblionumber
1862 my $dbh = C4::Context->dbh;
1863 &REALdelbiblio( $dbh, $biblio );
1864 my $bibid = &MARCfind_MARCbibid_from_oldbiblionumber( $dbh, $biblio );
1865 &MARCdelbiblio( $dbh, $bibid, 0 );
1868 =head2 ($count,@results) = getbiblio($biblionumber);
1872 return an array with hash of biblios.
1874 FIXME : biblionumber being the primary key, this sub will always return only 1 result, API should be modified...
1881 my ($biblionumber) = @_;
1882 my $dbh = C4::Context->dbh;
1883 my $sth = $dbh->prepare("Select * from biblio where biblionumber = ?");
1885 # || die "Cannot prepare $query\n" . $dbh->errstr;
1889 $sth->execute($biblionumber);
1891 # || die "Cannot execute $query\n" . $sth->errstr;
1892 while ( my $data = $sth->fetchrow_hashref ) {
1893 $results[$count] = $data;
1898 return ( $count, @results );
1903 $data = &bibdata($biblionumber, $type);
1905 Returns information about the book with the given biblionumber.
1907 C<$type> is ignored.
1909 C<&bibdata> returns a reference-to-hash. The keys are the fields in
1910 the C<biblio>, C<biblioitems>, and C<bibliosubtitle> tables in the
1913 In addition, C<$data-E<gt>{subject}> is the list of the book's
1914 subjects, separated by C<" , "> (space, comma, space).
1916 If there are multiple biblioitems with the given biblionumber, only
1917 the first one is considered.
1922 my ($bibnum, $type) = @_;
1923 my $dbh = C4::Context->dbh;
1924 my $sth = $dbh->prepare("Select *, biblioitems.notes AS bnotes, biblio.notes
1926 left join biblioitems on biblioitems.biblionumber = biblio.biblionumber
1927 left join bibliosubtitle on
1928 biblio.biblionumber = bibliosubtitle.biblionumber
1929 left join itemtypes on biblioitems.itemtype=itemtypes.itemtype
1930 where biblio.biblionumber = ?
1932 $sth->execute($bibnum);
1934 $data = $sth->fetchrow_hashref;
1936 # handle management of repeated subtitle
1937 $sth = $dbh->prepare("Select * from bibliosubtitle where biblionumber = ?");
1938 $sth->execute($bibnum);
1940 while (my $dat = $sth->fetchrow_hashref){
1942 $line{subtitle} = $dat->{subtitle};
1943 push @subtitles, \%line;
1945 $data->{subtitles} = \@subtitles;
1947 $sth = $dbh->prepare("Select * from bibliosubject where biblionumber = ?");
1948 $sth->execute($bibnum);
1950 while (my $dat = $sth->fetchrow_hashref){
1952 $line{subject} = $dat->{'subject'};
1953 push @subjects, \%line;
1955 $data->{subjects} = \@subjects;
1957 $sth = $dbh->prepare("Select * from additionalauthors where biblionumber = ?");
1958 $sth->execute($bibnum);
1959 while (my $dat = $sth->fetchrow_hashref){
1960 $data->{'additionalauthors'} .= "$dat->{'author'} - ";
1962 chop $data->{'additionalauthors'};
1963 chop $data->{'additionalauthors'};
1964 chop $data->{'additionalauthors'};
1969 =head2 ($count,@results) = getbiblioitem($biblioitemnumber);
1973 return an array with hash of biblioitemss.
1975 FIXME : biblioitemnumber being unique, this sub will always return only 1 result, API should be modified...
1982 my ($biblioitemnum) = @_;
1983 my $dbh = C4::Context->dbh;
1984 my $sth = $dbh->prepare( "Select * from biblioitems where
1985 biblioitemnumber = ?"
1990 $sth->execute($biblioitemnum);
1992 while ( my $data = $sth->fetchrow_hashref ) {
1993 $results[$count] = $data;
1998 return ( $count, @results );
1999 } # sub getbiblioitem
2001 =head2 ($count,@results) = getbiblioitembybiblionumber($biblionumber);
2005 return an array with hash of biblioitems for the given biblionumber.
2011 sub getbiblioitembybiblionumber {
2012 my ($biblionumber) = @_;
2013 my $dbh = C4::Context->dbh;
2014 my $sth = $dbh->prepare("Select * from biblioitems where biblionumber = ?");
2018 $sth->execute($biblionumber);
2020 while ( my $data = $sth->fetchrow_hashref ) {
2021 $results[$count] = $data;
2026 return ( $count, @results );
2029 =head2 ($count,@results) = getitemsbybiblioitem($biblionumber);
2033 returns an array with hash of items
2039 sub getitemsbybiblioitem {
2040 my ($biblioitemnum) = @_;
2041 my $dbh = C4::Context->dbh;
2042 my $sth = $dbh->prepare( "Select * from items, biblio where
2043 biblio.biblionumber = items.biblionumber and biblioitemnumber
2047 # || die "Cannot prepare $query\n" . $dbh->errstr;
2051 $sth->execute($biblioitemnum);
2053 # || die "Cannot execute $query\n" . $sth->errstr;
2054 while ( my $data = $sth->fetchrow_hashref ) {
2055 $results[$count] = $data;
2060 return ( $count, @results );
2061 } # sub getitemsbybiblioitem
2065 @results = &ItemInfo($env, $biblionumber, $type);
2067 Returns information about books with the given biblionumber.
2069 C<$type> may be either C<intra> or anything else. If it is not set to
2070 C<intra>, then the search will exclude lost, very overdue, and
2075 C<&ItemInfo> returns a list of references-to-hash. Each element
2076 contains a number of keys. Most of them are table items from the
2077 C<biblio>, C<biblioitems>, C<items>, and C<itemtypes> tables in the
2078 Koha database. Other keys include:
2082 =item C<$data-E<gt>{branchname}>
2084 The name (not the code) of the branch to which the book belongs.
2086 =item C<$data-E<gt>{datelastseen}>
2088 This is simply C<items.datelastseen>, except that while the date is
2089 stored in YYYY-MM-DD format in the database, here it is converted to
2090 DD/MM/YYYY format. A NULL date is returned as C<//>.
2092 =item C<$data-E<gt>{datedue}>
2094 =item C<$data-E<gt>{class}>
2096 This is the concatenation of C<biblioitems.classification>, the book's
2097 Dewey code, and C<biblioitems.subclass>.
2099 =item C<$data-E<gt>{ocount}>
2101 I think this is the number of copies of the book available.
2103 =item C<$data-E<gt>{order}>
2105 If this is set, it is set to C<One Order>.
2112 my ($env,$biblionumber,$type) = @_;
2113 my $dbh = C4::Context->dbh;
2114 my $query = "SELECT *,items.notforloan as itemnotforloan FROM items, biblio, biblioitems
2115 left join itemtypes on biblioitems.itemtype = itemtypes.itemtype
2116 WHERE items.biblionumber = ?
2117 AND biblioitems.biblioitemnumber = items.biblioitemnumber
2118 AND biblio.biblionumber = items.biblionumber";
2119 $query .= " order by items.dateaccessioned desc";
2120 my $sth=$dbh->prepare($query);
2121 $sth->execute($biblionumber);
2124 while (my $data=$sth->fetchrow_hashref){
2126 my $isth=$dbh->prepare("Select issues.*,borrowers.cardnumber from issues,borrowers where itemnumber = ? and returndate is null and issues.borrowernumber=borrowers.borrowernumber");
2127 $isth->execute($data->{'itemnumber'});
2128 if (my $idata=$isth->fetchrow_hashref){
2129 $data->{borrowernumber} = $idata->{borrowernumber};
2130 $data->{cardnumber} = $idata->{cardnumber};
2131 $datedue = format_date($idata->{'date_due'});
2133 if ($datedue eq ''){
2134 my ($restype,$reserves)=C4::Reserves2::CheckReserves($data->{'itemnumber'});
2140 #get branch information.....
2141 my $bsth=$dbh->prepare("SELECT * FROM branches WHERE branchcode = ?");
2142 $bsth->execute($data->{'holdingbranch'});
2143 if (my $bdata=$bsth->fetchrow_hashref){
2144 $data->{'branchname'} = $bdata->{'branchname'};
2146 my $date=format_date($data->{'datelastseen'});
2147 $data->{'datelastseen'}=$date;
2148 $data->{'datedue'}=$datedue;
2149 # get notforloan complete status if applicable
2150 my $sthnflstatus = $dbh->prepare('select authorised_value from marc_subfield_structure where kohafield="items.notforloan"');
2151 $sthnflstatus->execute;
2152 my ($authorised_valuecode) = $sthnflstatus->fetchrow;
2153 if ($authorised_valuecode) {
2154 $sthnflstatus = $dbh->prepare("select lib from authorised_values where category=? and authorised_value=?");
2155 $sthnflstatus->execute($authorised_valuecode,$data->{itemnotforloan});
2156 my ($lib) = $sthnflstatus->fetchrow;
2157 $data->{notforloan} = $lib;
2168 ($count, @results) = &bibitems($biblionumber);
2170 Given the biblionumber for a book, C<&bibitems> looks up that book's
2171 biblioitems (different publications of the same book, the audio book
2172 and film versions, etc.).
2174 C<$count> is the number of elements in C<@results>.
2176 C<@results> is an array of references-to-hash; the keys are the fields
2177 of the C<biblioitems> and C<itemtypes> tables of the Koha database. In
2178 addition, C<itemlost> indicates the availability of the item: if it is
2179 "2", then all copies of the item are long overdue; if it is "1", then
2180 all copies are lost; otherwise, there is at least one copy available.
2186 my $dbh = C4::Context->dbh;
2187 my $sth = $dbh->prepare("SELECT biblioitems.*,
2189 MIN(items.itemlost) as itemlost,
2190 MIN(items.dateaccessioned) as dateaccessioned
2191 FROM biblioitems, itemtypes, items
2192 WHERE biblioitems.biblionumber = ?
2193 AND biblioitems.itemtype = itemtypes.itemtype
2194 AND biblioitems.biblioitemnumber = items.biblioitemnumber
2195 GROUP BY items.biblioitemnumber");
2198 $sth->execute($bibnum);
2199 while (my $data = $sth->fetchrow_hashref) {
2200 $results[$count] = $data;
2204 return($count, @results);
2210 $itemdata = &bibitemdata($biblioitemnumber);
2212 Looks up the biblioitem with the given biblioitemnumber. Returns a
2213 reference-to-hash. The keys are the fields from the C<biblio>,
2214 C<biblioitems>, and C<itemtypes> tables in the Koha database, except
2215 that C<biblioitems.notes> is given as C<$itemdata-E<gt>{bnotes}>.
2221 my $dbh = C4::Context->dbh;
2222 my $sth = $dbh->prepare("Select *,biblioitems.notes as bnotes from biblio, biblioitems,itemtypes where biblio.biblionumber = biblioitems.biblionumber and biblioitemnumber = ? and biblioitems.itemtype = itemtypes.itemtype");
2225 $sth->execute($bibitem);
2227 $data = $sth->fetchrow_hashref;
2234 =item getbibliofromitemnumber
2236 $item = &getbibliofromitemnumber($env, $dbh, $itemnumber);
2238 Looks up the item with the given itemnumber.
2240 C<$env> and C<$dbh> are ignored.
2242 C<&itemnodata> returns a reference-to-hash whose keys are the fields
2243 from the C<biblio>, C<biblioitems>, and C<items> tables in the Koha
2248 sub getbibliofromitemnumber {
2249 my ($env,$dbh,$itemnumber) = @_;
2250 $dbh = C4::Context->dbh;
2251 my $sth=$dbh->prepare("Select * from biblio,items,biblioitems
2252 where items.itemnumber = ?
2253 and biblio.biblionumber = items.biblionumber
2254 and biblioitems.biblioitemnumber = items.biblioitemnumber");
2256 $sth->execute($itemnumber);
2257 my $data=$sth->fetchrow_hashref;
2264 @barcodes = &barcodes($biblioitemnumber);
2266 Given a biblioitemnumber, looks up the corresponding items.
2268 Returns an array of references-to-hash; the keys are C<barcode> and
2271 The returned items include very overdue items, but not lost ones.
2276 #called from request.pl
2277 my ($biblioitemnumber)=@_;
2278 my $dbh = C4::Context->dbh;
2279 my $sth=$dbh->prepare("SELECT barcode, itemlost, holdingbranch FROM items
2280 WHERE biblioitemnumber = ?
2281 AND (wthdrawn <> 1 OR wthdrawn IS NULL)");
2282 $sth->execute($biblioitemnumber);
2285 while (my $data=$sth->fetchrow_hashref){
2286 $barcodes[$i]=$data;
2296 $item = &itemdata($barcode);
2298 Looks up the item with the given barcode, and returns a
2299 reference-to-hash containing information about that item. The keys of
2300 the hash are the fields from the C<items> and C<biblioitems> tables in
2305 sub get_item_from_barcode {
2307 my $dbh = C4::Context->dbh;
2308 my $sth=$dbh->prepare("Select * from items,biblioitems where barcode=?
2309 and items.biblioitemnumber=biblioitems.biblioitemnumber");
2310 $sth->execute($barcode);
2311 my $data=$sth->fetchrow_hashref;
2319 @issues = &itemissues($biblioitemnumber, $biblio);
2321 Looks up information about who has borrowed the bookZ<>(s) with the
2322 given biblioitemnumber.
2324 C<$biblio> is ignored.
2326 C<&itemissues> returns an array of references-to-hash. The keys
2327 include the fields from the C<items> table in the Koha database.
2328 Additional keys include:
2334 If the item is currently on loan, this gives the due date.
2336 If the item is not on loan, then this is either "Available" or
2337 "Cancelled", if the item has been withdrawn.
2341 If the item is currently on loan, this gives the card number of the
2342 patron who currently has the item.
2344 =item C<timestamp0>, C<timestamp1>, C<timestamp2>
2346 These give the timestamp for the last three times the item was
2349 =item C<card0>, C<card1>, C<card2>
2351 The card number of the last three patrons who borrowed this item.
2353 =item C<borrower0>, C<borrower1>, C<borrower2>
2355 The borrower number of the last three patrons who borrowed this item.
2362 my ($bibitem, $biblio)=@_;
2363 my $dbh = C4::Context->dbh;
2364 # FIXME - If this function die()s, the script will abort, and the
2365 # user won't get anything; depending on how far the script has
2366 # gotten, the user might get a blank page. It would be much better
2367 # to at least print an error message. The easiest way to do this
2368 # is to set $SIG{__DIE__}.
2369 my $sth = $dbh->prepare("Select * from items where
2370 items.biblioitemnumber = ?")
2371 || die $dbh->errstr;
2375 $sth->execute($bibitem)
2376 || die $sth->errstr;
2378 while (my $data = $sth->fetchrow_hashref) {
2379 # Find out who currently has this item.
2380 # FIXME - Wouldn't it be better to do this as a left join of
2381 # some sort? Currently, this code assumes that if
2382 # fetchrow_hashref() fails, then the book is on the shelf.
2383 # fetchrow_hashref() can fail for any number of reasons (e.g.,
2384 # database server crash), not just because no items match the
2386 my $sth2 = $dbh->prepare("select * from issues,borrowers
2387 where itemnumber = ?
2388 and returndate is NULL
2389 and issues.borrowernumber = borrowers.borrowernumber");
2391 $sth2->execute($data->{'itemnumber'});
2392 if (my $data2 = $sth2->fetchrow_hashref) {
2393 $data->{'date_due'} = $data2->{'date_due'};
2394 $data->{'card'} = $data2->{'cardnumber'};
2395 $data->{'borrower'} = $data2->{'borrowernumber'};
2397 if ($data->{'wthdrawn'} eq '1') {
2398 $data->{'date_due'} = 'Cancelled';
2400 $data->{'date_due'} = 'Available';
2406 # Find the last 3 people who borrowed this item.
2407 $sth2 = $dbh->prepare("select * from issues, borrowers
2408 where itemnumber = ?
2409 and issues.borrowernumber = borrowers.borrowernumber
2410 and returndate is not NULL
2411 order by returndate desc,timestamp desc") || die $dbh->errstr;
2412 $sth2->execute($data->{'itemnumber'}) || die $sth2->errstr;
2413 for (my $i2 = 0; $i2 < 2; $i2++) { # FIXME : error if there is less than 3 pple borrowing this item
2414 if (my $data2 = $sth2->fetchrow_hashref) {
2415 $data->{"timestamp$i2"} = $data2->{'timestamp'};
2416 $data->{"card$i2"} = $data2->{'cardnumber'};
2417 $data->{"borrower$i2"} = $data2->{'borrowernumber'};
2422 $results[$i] = $data;
2432 ($count, $subjects) = &getsubject($biblionumber);
2434 Looks up the subjects of the book with the given biblionumber. Returns
2435 a two-element list. C<$subjects> is a reference-to-array, where each
2436 element is a subject of the book, and C<$count> is the number of
2437 elements in C<$subjects>.
2443 my $dbh = C4::Context->dbh;
2444 my $sth=$dbh->prepare("Select * from bibliosubject where biblionumber=?");
2445 $sth->execute($bibnum);
2448 while (my $data=$sth->fetchrow_hashref){
2453 return($i,\@results);
2458 ($count, $authors) = &getaddauthor($biblionumber);
2460 Looks up the additional authors for the book with the given
2463 Returns a two-element list. C<$authors> is a reference-to-array, where
2464 each element is an additional author, and C<$count> is the number of
2465 elements in C<$authors>.
2471 my $dbh = C4::Context->dbh;
2472 my $sth=$dbh->prepare("Select * from additionalauthors where biblionumber=?");
2473 $sth->execute($bibnum);
2476 while (my $data=$sth->fetchrow_hashref){
2481 return($i,\@results);
2487 ($count, $subtitles) = &getsubtitle($biblionumber);
2489 Looks up the subtitles for the book with the given biblionumber.
2491 Returns a two-element list. C<$subtitles> is a reference-to-array,
2492 where each element is a subtitle, and C<$count> is the number of
2493 elements in C<$subtitles>.
2499 my $dbh = C4::Context->dbh;
2500 my $sth=$dbh->prepare("Select * from bibliosubtitle where biblionumber=?");
2501 $sth->execute($bibnum);
2504 while (my $data=$sth->fetchrow_hashref){
2509 return($i,\@results);
2515 ($count, @websites) = &getwebsites($biblionumber);
2517 Looks up the web sites pertaining to the book with the given
2520 C<$count> is the number of elements in C<@websites>.
2522 C<@websites> is an array of references-to-hash; the keys are the
2523 fields from the C<websites> table in the Koha database.
2526 #FIXME : could maybe be deleted. Otherwise, would be better in a Websites.pm package
2527 #(with add / modify / delete subs)
2530 my ($biblionumber) = @_;
2531 my $dbh = C4::Context->dbh;
2532 my $sth = $dbh->prepare("Select * from websites where biblionumber = ?");
2536 $sth->execute($biblionumber);
2537 while (my $data = $sth->fetchrow_hashref) {
2538 # FIXME - The URL scheme shouldn't be stripped off, at least
2539 # not here, since it's part of the URL, and will be useful in
2540 # constructing a link to the site. If you don't want the user
2541 # to see the "http://" part, strip that off when building the
2543 $data->{'url'} =~ s/^http:\/\///; # FIXME - Leaning toothpick
2545 $results[$count] = $data;
2550 return($count, @results);
2553 =item getwebbiblioitems
2555 ($count, @results) = &getwebbiblioitems($biblionumber);
2557 Given a book's biblionumber, looks up the web versions of the book
2558 (biblioitems with itemtype C<WEB>).
2560 C<$count> is the number of items in C<@results>. C<@results> is an
2561 array of references-to-hash; the keys are the items from the
2562 C<biblioitems> table of the Koha database.
2566 sub getwebbiblioitems {
2567 my ($biblionumber) = @_;
2568 my $dbh = C4::Context->dbh;
2569 my $sth = $dbh->prepare("Select * from biblioitems where biblionumber = ?
2570 and itemtype = 'WEB'");
2574 $sth->execute($biblionumber);
2575 while (my $data = $sth->fetchrow_hashref) {
2576 $data->{'url'} =~ s/^http:\/\///;
2577 $results[$count] = $data;
2582 return($count, @results);
2583 } # sub getwebbiblioitems
2587 # converts ISO 5426 coded string to ISO 8859-1
2588 # sloppy code : should be improved in next issue
2589 my ( $string, $encoding ) = @_;
2592 # $encoding = C4::Context->preference("marcflavour") unless $encoding;
2593 if ( $encoding eq "UNIMARC" ) {
2662 # this handles non-sorting blocks (if implementation requires this)
2663 $string = nsb_clean($_);
2665 elsif ( $encoding eq "USMARC" || $encoding eq "MARC21" ) {
2666 if (/[\xc1-\xff]/) {
2719 # this handles non-sorting blocks (if implementation requires this)
2720 $string = nsb_clean($_);
2727 my $NSB = '\x88'; # NSB : begin Non Sorting Block
2728 my $NSE = '\x89'; # NSE : Non Sorting Block end
2729 # handles non sorting blocks
2733 s/[ ]{0,1}$NSE/) /gm;
2740 my $dbh = C4::Context->dbh;
2741 my $result = MARCmarc2koha($dbh,$record,'');
2743 my ($biblionumber,$bibid,$title);
2744 # search duplicate on ISBN, easy and fast...
2745 if ($result->{isbn}) {
2746 $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=?");
2747 $sth->execute($result->{'isbn'});
2748 ($biblionumber,$bibid,$title) = $sth->fetchrow;
2749 return $biblionumber,$bibid,$title if ($biblionumber);
2751 # a more complex search : build a request for SearchMarc::catalogsearch()
2752 my (@tags, @and_or, @excluding, @operator, @value, $offset,$length);
2753 # search on biblio.title
2754 my ($tag,$subfield) = MARCfind_marc_from_kohafield($dbh,"biblio.title","");
2755 if ($record->field($tag)) {
2756 if ($record->field($tag)->subfields($subfield)) {
2757 push @tags, "'".$tag.$subfield."'";
2758 push @and_or, "and";
2759 push @excluding, "";
2760 push @operator, "contains";
2761 push @value, $record->field($tag)->subfield($subfield);
2762 # warn "for title, I add $tag / $subfield".$record->field($tag)->subfield($subfield);
2765 # ... and on biblio.author
2766 ($tag,$subfield) = MARCfind_marc_from_kohafield($dbh,"biblio.author","");
2767 if ($record->field($tag)) {
2768 if ($record->field($tag)->subfields($subfield)) {
2769 push @tags, "'".$tag.$subfield."'";
2770 push @and_or, "and";
2771 push @excluding, "";
2772 push @operator, "contains";
2773 push @value, $record->field($tag)->subfield($subfield);
2774 # warn "for author, I add $tag / $subfield".$record->field($tag)->subfield($subfield);
2777 # ... and on publicationyear.
2778 ($tag,$subfield) = MARCfind_marc_from_kohafield($dbh,"biblioitems.publicationyear","");
2779 if ($record->field($tag)) {
2780 if ($record->field($tag)->subfields($subfield)) {
2781 push @tags, "'".$tag.$subfield."'";
2782 push @and_or, "and";
2783 push @excluding, "";
2784 push @operator, "=";
2785 push @value, $record->field($tag)->subfield($subfield);
2786 # warn "for publicationyear, I add $tag / $subfield".$record->field($tag)->subfield($subfield);
2790 ($tag,$subfield) = MARCfind_marc_from_kohafield($dbh,"biblioitems.size","");
2791 if ($record->field($tag)) {
2792 if ($record->field($tag)->subfields($subfield)) {
2793 push @tags, "'".$tag.$subfield."'";
2794 push @and_or, "and";
2795 push @excluding, "";
2796 push @operator, "=";
2797 push @value, $record->field($tag)->subfield($subfield);
2798 # warn "for size, I add $tag / $subfield".$record->field($tag)->subfield($subfield);
2801 # ... and on publisher.
2802 ($tag,$subfield) = MARCfind_marc_from_kohafield($dbh,"biblioitems.publishercode","");
2803 if ($record->field($tag)) {
2804 if ($record->field($tag)->subfields($subfield)) {
2805 push @tags, "'".$tag.$subfield."'";
2806 push @and_or, "and";
2807 push @excluding, "";
2808 push @operator, "=";
2809 push @value, $record->field($tag)->subfield($subfield);
2810 # warn "for publishercode, I add $tag / $subfield".$record->field($tag)->subfield($subfield);
2813 # ... and on volume.
2814 ($tag,$subfield) = MARCfind_marc_from_kohafield($dbh,"biblioitems.volume","");
2815 if ($record->field($tag)) {
2816 if ($record->field($tag)->subfields($subfield)) {
2817 push @tags, "'".$tag.$subfield."'";
2818 push @and_or, "and";
2819 push @excluding, "";
2820 push @operator, "=";
2821 push @value, $record->field($tag)->subfield($subfield);
2822 # warn "for volume, I add $tag / $subfield".$record->field($tag)->subfield($subfield);
2826 my ($finalresult,$nbresult) = C4::SearchMarc::catalogsearch($dbh,\@tags,\@and_or,\@excluding,\@operator,\@value,0,10);
2827 # there is at least 1 result => return the 1st one
2829 # warn "$nbresult => ".@$finalresult[0]->{biblionumber},@$finalresult[0]->{bibid},@$finalresult[0]->{title};
2830 return @$finalresult[0]->{biblionumber},@$finalresult[0]->{bibid},@$finalresult[0]->{title};
2832 # no result, returns nothing
2839 if(substr($isbn, 0, 1) <=7) {
2840 $seg1 = substr($isbn, 0, 1);
2841 } elsif(substr($isbn, 0, 2) <= 94) {
2842 $seg1 = substr($isbn, 0, 2);
2843 } elsif(substr($isbn, 0, 3) <= 995) {
2844 $seg1 = substr($isbn, 0, 3);
2845 } elsif(substr($isbn, 0, 4) <= 9989) {
2846 $seg1 = substr($isbn, 0, 4);
2848 $seg1 = substr($isbn, 0, 5);
2850 my $x = substr($isbn, length($seg1));
2852 if(substr($x, 0, 2) <= 19) {
2853 # if(sTmp2 < 10) sTmp2 = "0" sTmp2;
2854 $seg2 = substr($x, 0, 2);
2855 } elsif(substr($x, 0, 3) <= 699) {
2856 $seg2 = substr($x, 0, 3);
2857 } elsif(substr($x, 0, 4) <= 8399) {
2858 $seg2 = substr($x, 0, 4);
2859 } elsif(substr($x, 0, 5) <= 89999) {
2860 $seg2 = substr($x, 0, 5);
2861 } elsif(substr($x, 0, 6) <= 9499999) {
2862 $seg2 = substr($x, 0, 6);
2864 $seg2 = substr($x, 0, 7);
2866 my $seg3=substr($x,length($seg2));
2867 $seg3=substr($seg3,0,length($seg3)-1) ;
2868 my $seg4 = substr($x, -1, 1);
2869 return "$seg1-$seg2-$seg3-$seg4";
2873 END { } # module clean-up code here (global destructor)
2879 Koha Developement team <info@koha.org>
2881 Paul POULAIN paul.poulain@free.fr
2887 # Revision 1.134 2006/01/04 15:54:55 tipaul
2888 # utf8 is a : go for beta test in HEAD.
2889 # some explanations :
2890 # - updater/updatedatabase => will transform all tables in innoDB (not related to utf8, just to warn you) AND collate them in utf8 / utf8_general_ci. The SQL command is : ALTER TABLE tablename DEFAULT CHARACTER SET utf8 COLLATE utf8_general_ci.
2891 # - *-top.inc will show the pages in utf8
2892 # - THE HARD THING : for me, mysql-client and mysql-server were set up to communicate in iso8859-1, whatever the mysql collation ! Thus, pages were improperly shown, as datas were transmitted in iso8859-1 format ! After a full day of investigation, someone on usenet pointed "set NAMES 'utf8'" to explain that I wanted utf8. I could put this in my.cnf, but if I do that, ALL databases will "speak" in utf8, that's not what we want. Thus, I added a line in Context.pm : everytime a DB handle is opened, the communication is set to utf8.
2893 # - using marcxml field and no more the iso2709 raw marc biblioitems.marc field.
2895 # Revision 1.133 2005/12/12 14:25:51 thd
2898 # Reverse array filled with elements from repeated subfields
2899 # to avoid last to first concatenation of elements in Koha DB.-
2901 # Revision 1.132 2005-10-26 09:12:33 tipaul
2902 # big commit, still breaking things...
2904 # * synch with rel_2_2. Probably the last non manual synch, as rel_2_2 should not be modified deeply.
2905 # * code cleaning (cleaning warnings from perl -w) continued
2907 # Revision 1.131 2005/09/22 10:01:45 tipaul
2908 # see mail on koha-devel : code cleaning on Search.pm + normalizing API + use of biblionumber everywhere (instead of bn, biblio, ...)
2910 # Revision 1.130 2005/09/02 14:34:14 tipaul
2911 # continuing the work to move to zebra. Begin of work for MARC=OFF support.
2912 # IMPORTANT NOTE : the MARCkoha2marc sub API has been modified. Instead of biblionumber & biblioitemnumber, it now gets a hash.
2913 # The sub is used only in Biblio.pm, so the API change should be harmless (except for me, but i'm aware ;-) )
2915 # Revision 1.129 2005/08/12 13:50:31 tipaul
2916 # removing useless sub declarations
2918 # Revision 1.128 2005/08/11 16:12:47 tipaul
2919 # Playing with the zebra...
2921 # * go to koha cvs home directory
2922 # * in misc/zebra there is a unimarc directory. I suggest that marc21 libraries create a marc21 directory
2923 # * put your zebra.cfg files here & create your database.
2924 # * from koha cvs home directory, ln -s misc/zebra/marc21 zebra (I mean create a symbolic link to YOUR zebra directory)
2925 # * now, everytime you add/modify a biblio/item your zebra DB is updated correctly.
2928 # * this uses a system call in perl. CPU consumming, but we are waiting for indexdata Perl/zoom
2929 # * deletion still not work
2930 # * UNIMARC zebra config files are provided in misc/zebra/unimarc directory. The most important line being :
2932 # recordId: (bib1,Local-number)
2936 # elm 090 Local-number -
2937 # elm 090/? Local-number -
2938 # elm 090/?/9 Local-number !:w
2940 # (090$9 being the field mapped to biblio.biblionumber in Koha)
2942 # Revision 1.127 2005/08/11 14:37:32 tipaul
2944 # * removing useless subs
2945 # * removing some subs that are also elsewhere
2946 # * 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)
2948 # Revision 1.126 2005/08/11 09:13:28 tipaul
2949 # just removing useless subs (a lot !!!) for code cleaning
2951 # Revision 1.125 2005/08/11 09:00:07 tipaul
2952 # Ok guys, this time, it seems that item add and modif begin working as expected...
2953 # Still a lot of bugs to fix, of course
2955 # Revision 1.124 2005/08/10 10:21:15 tipaul
2956 # continuing the road to zebra :
2957 # - the biblio add begins to work.
2958 # - the biblio modif begins to work.
2960 # (still without doing anything on zebra)
2961 # (no new change in updatedatabase)
2963 # Revision 1.123 2005/08/09 14:10:28 tipaul
2964 # 1st commit to go to zebra.
2965 # don't update your cvs if you want to have a working head...
2967 # this commit contains :
2968 # * 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...
2969 # * 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.
2970 # * other files : get rid of bibid and use biblionumber instead.
2973 # * does not do anything on zebra yet.
2974 # * if you rename marc_subfield_table, you can't search anymore.
2975 # * you can view a biblio & bibliodetails, go to MARC editor, but NOT save any modif.
2976 # * 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 ;-) )
2978 # 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
2979 # 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.
2981 # tipaul cutted previous commit notes