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->{$tab}->{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 marc from biblioitems where biblionumber=?');
281 $sth->execute($biblionumber);
282 my ($marc) = $sth->fetchrow;
283 my $record = MARC::File::USMARC::decode($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 my $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 $result=&MARCmarc2kohaOneField($sth,"biblio",$field,$record,$result,$frameworkcode);
553 $sth2=$dbh->prepare("SHOW COLUMNS from biblioitems");
555 while (($field)=$sth2->fetchrow) {
556 if ($field eq 'notes') { $field = 'bnotes'; }
557 $result=&MARCmarc2kohaOneField($sth,"biblioitems",$field,$record,$result,$frameworkcode);
559 $sth2=$dbh->prepare("SHOW COLUMNS from items");
561 while (($field)=$sth2->fetchrow) {
562 $result=&MARCmarc2kohaOneField($sth,"items",$field,$record,$result,$frameworkcode);
564 # additional authors : specific
565 $result = &MARCmarc2kohaOneField($sth,"bibliosubtitle","subtitle",$record,$result,$frameworkcode);
566 $result = &MARCmarc2kohaOneField($sth,"additionalauthors","additionalauthors",$record,$result,$frameworkcode);
567 # modify copyrightdate to keep only the 1st year found
568 my $temp = $result->{'copyrightdate'};
569 $temp =~ m/c(\d\d\d\d)/; # search cYYYY first
571 $result->{'copyrightdate'} = $1;
572 } else { # if no cYYYY, get the 1st date.
573 $temp =~ m/(\d\d\d\d)/;
574 $result->{'copyrightdate'} = $1;
576 # modify publicationyear to keep only the 1st year found
577 $temp = $result->{'publicationyear'};
578 $temp =~ m/c(\d\d\d\d)/; # search cYYYY first
580 $result->{'publicationyear'} = $1;
581 } else { # if no cYYYY, get the 1st date.
582 $temp =~ m/(\d\d\d\d)/;
583 $result->{'publicationyear'} = $1;
588 sub MARCmarc2kohaOneField {
590 # FIXME ? if a field has a repeatable subfield that is used in old-db, only the 1st will be retrieved...
591 my ( $sth, $kohatable, $kohafield, $record, $result,$frameworkcode ) = @_;
592 # warn "kohatable / $kohafield / $result / ";
596 ( $tagfield, $subfield ) = MARCfind_marc_from_kohafield("",$kohatable.".".$kohafield,$frameworkcode);
597 foreach my $field ( $record->field($tagfield) ) {
598 if ($field->tag()<10) {
599 if ($result->{$kohafield}) {
600 $result->{$kohafield} .= " | ".$field->data();
602 $result->{$kohafield} = $field->data();
605 if ( $field->subfields ) {
606 my @subfields = $field->subfields();
607 foreach my $subfieldcount ( 0 .. $#subfields ) {
608 if ($subfields[$subfieldcount][0] eq $subfield) {
609 if ( $result->{$kohafield} ) {
610 $result->{$kohafield} .= " | " . $subfields[$subfieldcount][1];
613 $result->{$kohafield} = $subfields[$subfieldcount][1];
620 # warn "OneField for $kohatable.$kohafield and $frameworkcode=> $tagfield, $subfield";
624 =head2 ($biblionumber,$biblioitemnumber) = NEWnewbibilio($dbh,$MARCRecord,$frameworkcode);
628 creates a biblio from a MARC::Record.
635 my ( $dbh, $record, $frameworkcode ) = @_;
637 my $biblioitemnumber;
638 my $olddata = MARCmarc2koha( $dbh, $record,$frameworkcode );
639 $olddata->{frameworkcode} = $frameworkcode;
640 $biblionumber = REALnewbiblio( $dbh, $olddata );
641 $olddata->{biblionumber} = $biblionumber;
642 # add biblionumber into the MARC record (it's the ID for zebra)
643 my ( $tagfield, $tagsubfield ) =
644 MARCfind_marc_from_kohafield( $dbh, "biblio.biblionumber",$frameworkcode );
648 $newfield = MARC::Field->new(
649 $tagfield, $biblionumber,
652 $newfield = MARC::Field->new(
653 $tagfield, '', '', "$tagsubfield" => $biblionumber,
656 # drop old field (just in case it already exist and create new one...
657 my $old_field = $record->field($tagfield);
658 $record->delete_field($old_field);
659 $record->add_fields($newfield);
661 #create the marc entry, that stores the rax marc record in Koha 3.0
662 $olddata->{marc} = $record->as_usmarc();
663 $olddata->{marcxml} = $record->as_xml();
664 # and create biblioitem, that's all folks !
665 $biblioitemnumber = REALnewbiblioitem( $dbh, $olddata );
667 # search subtiles, addiauthors and subjects
668 ( $tagfield, $tagsubfield ) =
669 MARCfind_marc_from_kohafield( $dbh, "additionalauthors.author",$frameworkcode );
670 my @addiauthfields = $record->field($tagfield);
671 foreach my $addiauthfield (@addiauthfields) {
672 my @addiauthsubfields = $addiauthfield->subfield($tagsubfield);
673 foreach my $subfieldcount ( 0 .. $#addiauthsubfields ) {
674 REALmodaddauthor( $dbh, $biblionumber,
675 $addiauthsubfields[$subfieldcount] );
678 ( $tagfield, $tagsubfield ) =
679 MARCfind_marc_from_kohafield( $dbh, "bibliosubtitle.subtitle",$frameworkcode );
680 my @subtitlefields = $record->field($tagfield);
681 foreach my $subtitlefield (@subtitlefields) {
682 my @subtitlesubfields = $subtitlefield->subfield($tagsubfield);
683 foreach my $subfieldcount ( 0 .. $#subtitlesubfields ) {
684 REALnewsubtitle( $dbh, $biblionumber,
685 $subtitlesubfields[$subfieldcount] );
688 ( $tagfield, $tagsubfield ) =
689 MARCfind_marc_from_kohafield( $dbh, "bibliosubject.subject",$frameworkcode );
690 my @subj = $record->field($tagfield);
692 foreach my $subject (@subj) {
693 my @subjsubfield = $subject->subfield($tagsubfield);
694 foreach my $subfieldcount ( 0 .. $#subjsubfield ) {
695 push @subjects, $subjsubfield[$subfieldcount];
698 REALmodsubject( $dbh, $biblionumber, 1, @subjects );
699 return ( $biblionumber, $biblioitemnumber );
702 =head2 NEWmodbilbioframework($dbh,$biblionumber,$frameworkcode);
706 modify the framework of a biblio
712 sub NEWmodbiblioframework {
713 my ($dbh,$biblionumber,$frameworkcode) =@_;
714 my $sth = $dbh->prepare("Update biblio SET frameworkcode=? WHERE biblionumber=?");
715 $sth->execute($frameworkcode,$biblionumber);
719 =head2 NEWmodbiblio($dbh,$MARCrecord,$biblionumber,$frameworkcode);
723 modify a biblio (MARC=ON)
730 my ($dbh,$record,$biblionumber,$frameworkcode) =@_;
731 $frameworkcode="" unless $frameworkcode;
732 # &MARCmodbiblio($dbh,$bibid,$record,$frameworkcode,0);
733 my $oldbiblio = MARCmarc2koha($dbh,$record,$frameworkcode);
735 $oldbiblio->{frameworkcode} = $frameworkcode;
736 #create the marc entry, that stores the rax marc record in Koha 3.0
737 $oldbiblio->{marc} = $record->as_usmarc();
738 $oldbiblio->{marcxml} = $record->as_xml();
740 REALmodbiblio($dbh,$oldbiblio);
741 REALmodbiblioitem($dbh,$oldbiblio);
742 # now, modify addi authors, subject, addititles.
743 my ($tagfield,$tagsubfield) = MARCfind_marc_from_kohafield($dbh,"additionalauthors.author",$frameworkcode);
744 my @addiauthfields = $record->field($tagfield);
745 foreach my $addiauthfield (@addiauthfields) {
746 my @addiauthsubfields = $addiauthfield->subfield($tagsubfield);
747 foreach my $subfieldcount (0..$#addiauthsubfields) {
748 REALmodaddauthor($dbh,$biblionumber,$addiauthsubfields[$subfieldcount]);
751 ($tagfield,$tagsubfield) = MARCfind_marc_from_kohafield($dbh,"bibliosubtitle.subtitle",$frameworkcode);
752 my @subtitlefields = $record->field($tagfield);
753 foreach my $subtitlefield (@subtitlefields) {
754 my @subtitlesubfields = $subtitlefield->subfield($tagsubfield);
755 # delete & create subtitle again because REALmodsubtitle can't handle new subtitles
757 $dbh->do("delete from bibliosubtitle where biblionumber=$biblionumber");
758 foreach my $subfieldcount (0..$#subtitlesubfields) {
759 foreach my $subtit(split /\||#/,$subtitlesubfields[$subfieldcount]) {
760 REALnewsubtitle($dbh,$biblionumber,$subtit);
764 ($tagfield,$tagsubfield) = MARCfind_marc_from_kohafield($dbh,"bibliosubject.subject",$frameworkcode);
765 my @subj = $record->field($tagfield);
767 foreach my $subject (@subj) {
768 my @subjsubfield = $subject->subfield($tagsubfield);
769 foreach my $subfieldcount (0..$#subjsubfield) {
770 push @subjects,$subjsubfield[$subfieldcount];
773 REALmodsubject($dbh,$biblionumber,1,@subjects);
777 =head2 NEWmodbilbioframework($dbh,$biblionumber,$frameworkcode);
788 my ( $dbh, $bibid ) = @_;
789 my $biblio = &MARCfind_oldbiblionumber_from_MARCbibid( $dbh, $bibid );
790 &REALdelbiblio( $dbh, $biblio );
793 "select biblioitemnumber from biblioitems where biblionumber=?");
794 $sth->execute($biblio);
795 while ( my ($biblioitemnumber) = $sth->fetchrow ) {
796 REALdelbiblioitem( $dbh, $biblioitemnumber );
798 &MARCdelbiblio( $dbh, $bibid, 0 );
801 =head2 $itemnumber = NEWnewitem($dbh, $record, $biblionumber, $biblioitemnumber);
805 creates an item from a MARC::Record
812 my ( $dbh, $record, $biblionumber, $biblioitemnumber ) = @_;
815 my $frameworkcode=MARCfind_frameworkcode($dbh,$biblionumber);
816 my $item = &MARCmarc2koha( $dbh, $record,$frameworkcode );
817 # needs old biblionumber and biblioitemnumber
818 $item->{'biblionumber'} = $biblionumber;
819 $item->{'biblioitemnumber'}=$biblioitemnumber;
820 $item->{marc} = $record->as_usmarc();
821 my ( $itemnumber, $error ) = &REALnewitems( $dbh, $item, $item->{barcode} );
826 =head2 $itemnumber = NEWmoditem($dbh, $record, $biblionumber, $biblioitemnumber,$itemnumber);
837 my ( $dbh, $record, $biblionumber, $biblioitemnumber, $itemnumber) = @_;
839 my $frameworkcode=MARCfind_frameworkcode($dbh,$biblionumber);
840 my $olditem = MARCmarc2koha( $dbh, $record,$frameworkcode );
842 $olditem->{marc} = $record->as_usmarc();
843 $olditem->{biblionumber} = $biblionumber;
844 $olditem->{biblioitemnumber} = $biblioitemnumber;
846 REALmoditem( $dbh, $olditem );
850 =head2 $itemnumber = NEWdelitem($dbh, $biblionumber, $biblioitemnumber, $itemnumber);
861 my ( $dbh, $bibid, $itemnumber ) = @_;
862 my $biblio = &MARCfind_oldbiblionumber_from_MARCbibid( $dbh, $bibid );
863 &REALdelitem( $dbh, $itemnumber );
864 &MARCdelitem( $dbh, $bibid, $itemnumber );
868 =head2 $biblionumber = REALnewbiblio($dbh,$biblio);
872 adds a record in biblio table. Datas are in the hash $biblio.
879 my ( $dbh, $biblio ) = @_;
881 $dbh->do('lock tables biblio WRITE');
882 my $sth = $dbh->prepare("Select max(biblionumber) from biblio");
884 my $data = $sth->fetchrow_arrayref;
885 my $bibnum = $$data[0] + 1;
888 if ( $biblio->{'seriestitle'} ) { $series = 1 }
891 $dbh->prepare("insert into biblio set biblionumber=?, title=?, author=?, copyrightdate=?,
892 serial=?, seriestitle=?, notes=?, abstract=?,
896 $bibnum, $biblio->{'title'},
897 $biblio->{'author'}, $biblio->{'copyrightdate'},
898 $biblio->{'serial'}, $biblio->{'seriestitle'},
899 $biblio->{'notes'}, $biblio->{'abstract'},
900 $biblio->{'unititle'}
904 $dbh->do('unlock tables');
908 =head2 $biblionumber = REALmodbiblio($dbh,$biblio);
912 modify a record in biblio table. Datas are in the hash $biblio.
919 my ( $dbh, $biblio ) = @_;
920 my $sth = $dbh->prepare("Update biblio set title=?, author=?, abstract=?, copyrightdate=?,
921 seriestitle=?, serial=?, unititle=?, notes=?, frameworkcode=?
922 where biblionumber = ?"
925 $biblio->{'title'}, $biblio->{'author'},
926 $biblio->{'abstract'}, $biblio->{'copyrightdate'},
927 $biblio->{'seriestitle'}, $biblio->{'serial'},
928 $biblio->{'unititle'}, $biblio->{'notes'},
929 $biblio->{frameworkcode},
930 $biblio->{'biblionumber'}
933 return ( $biblio->{'biblionumber'} );
936 =head2 REALmodsubtitle($dbh,$bibnum,$subtitle);
940 modify subtitles in bibliosubtitle table.
946 sub REALmodsubtitle {
947 my ( $dbh, $bibnum, $subtitle ) = @_;
950 "update bibliosubtitle set subtitle = ? where biblionumber = ?");
951 $sth->execute( $subtitle, $bibnum );
955 =head2 REALmodaddauthor($dbh,$bibnum,$author);
959 adds or modify additional authors
960 NOTE : Strange sub : seems to delete MANY and add only ONE author... maybe buggy ?
966 sub REALmodaddauthor {
967 my ( $dbh, $bibnum, @authors ) = @_;
969 # my $dbh = C4Connect;
971 $dbh->prepare("Delete from additionalauthors where biblionumber = ?");
973 $sth->execute($bibnum);
975 foreach my $author (@authors) {
976 if ( $author ne '' ) {
979 "Insert into additionalauthors set author = ?, biblionumber = ?"
982 $sth->execute( $author, $bibnum );
989 =head2 $errors = REALmodsubject($dbh,$bibnum, $force, @subject);
999 my ( $dbh, $bibnum, $force, @subject ) = @_;
1001 # my $dbh = C4Connect;
1002 my $count = @subject;
1004 for ( my $i = 0 ; $i < $count ; $i++ ) {
1005 $subject[$i] =~ s/^ //g;
1006 $subject[$i] =~ s/ $//g;
1009 "select * from catalogueentry where entrytype = 's' and catalogueentry = ?"
1011 $sth->execute( $subject[$i] );
1013 if ( my $data = $sth->fetchrow_hashref ) {
1016 if ( $force eq $subject[$i] || $force == 1 ) {
1018 # subject not in aut, chosen to force anway
1019 # so insert into cataloguentry so its in auth file
1022 "Insert into catalogueentry (entrytype,catalogueentry) values ('s',?)"
1025 $sth2->execute( $subject[$i] ) if ( $subject[$i] );
1030 "$subject[$i]\n does not exist in the subject authority file";
1033 "Select * from catalogueentry where entrytype = 's' and (catalogueentry like ? or catalogueentry like ? or catalogueentry like ?)"
1035 $sth2->execute( "$subject[$i] %", "% $subject[$i] %",
1037 while ( my $data = $sth2->fetchrow_hashref ) {
1038 $error .= "<br>$data->{'catalogueentry'}";
1045 if ( $error eq '' ) {
1047 $dbh->prepare("Delete from bibliosubject where biblionumber = ?");
1048 $sth->execute($bibnum);
1052 "Insert into bibliosubject (subject,biblionumber) values (?,?)");
1054 foreach $query (@subject) {
1055 $sth->execute( $query, $bibnum ) if ( $query && $bibnum );
1064 =head2 REALmodbiblioitem($dbh, $biblioitem);
1073 sub REALmodbiblioitem {
1074 my ( $dbh, $biblioitem ) = @_;
1077 my $sth = $dbh->prepare("update biblioitems set number=?,volume=?, volumedate=?, lccn=?,
1078 itemtype=?, url=?, isbn=?, issn=?,
1079 publishercode=?, publicationyear=?, classification=?, dewey=?,
1080 subclass=?, illus=?, pages=?, volumeddesc=?,
1081 notes=?, size=?, place=?, marc=?,
1083 where biblioitemnumber=?");
1084 $sth->execute( $biblioitem->{number}, $biblioitem->{volume}, $biblioitem->{volumedate}, $biblioitem->{lccn},
1085 $biblioitem->{itemtype}, $biblioitem->{url}, $biblioitem->{isbn}, $biblioitem->{issn},
1086 $biblioitem->{publishercode}, $biblioitem->{publicationyear}, $biblioitem->{classification}, $biblioitem->{dewey},
1087 $biblioitem->{subclass}, $biblioitem->{illus}, $biblioitem->{pages}, $biblioitem->{volumeddesc},
1088 $biblioitem->{bnotes}, $biblioitem->{size}, $biblioitem->{place}, $biblioitem->{marc},
1089 $biblioitem->{marcxml}, $biblioitem->{biblioitemnumber});
1090 my $record = MARC::File::USMARC::decode($biblioitem->{marc});
1091 zebra_create($biblioitem->{biblionumber}, $record);
1092 # warn "MOD : $biblioitem->{biblioitemnumber} = ".$biblioitem->{marc};
1095 =head2 REALnewbiblioitem($dbh,$biblioitem);
1099 adds a biblioitem ($biblioitem is a hash with the values)
1105 sub REALnewbiblioitem {
1106 my ( $dbh, $biblioitem ) = @_;
1108 $dbh->do("lock tables biblioitems WRITE, biblio WRITE, marc_subfield_structure READ");
1109 my $sth = $dbh->prepare("Select max(biblioitemnumber) from biblioitems");
1111 my $biblioitemnumber;
1114 $data = $sth->fetchrow_arrayref;
1115 $biblioitemnumber = $$data[0] + 1;
1117 # Insert biblioitemnumber in MARC record, we need it to manage items later...
1118 my $frameworkcode=MARCfind_frameworkcode($dbh,$biblioitem->{biblionumber});
1119 my ($biblioitemnumberfield,$biblioitemnumbersubfield) = MARCfind_marc_from_kohafield($dbh,'biblioitems.biblioitemnumber',$frameworkcode);
1120 my $record = MARC::File::USMARC::decode($biblioitem->{marc});
1121 my $field=$record->field($biblioitemnumberfield);
1122 $field->update($biblioitemnumbersubfield => "$biblioitemnumber");
1123 $biblioitem->{marc} = $record->as_usmarc();
1124 $biblioitem->{marcxml} = $record->as_xml();
1126 $sth = $dbh->prepare( "insert into biblioitems set
1127 biblioitemnumber = ?, biblionumber = ?,
1128 volume = ?, number = ?,
1129 classification = ?, itemtype = ?,
1131 issn = ?, dewey = ?,
1132 subclass = ?, publicationyear = ?,
1133 publishercode = ?, volumedate = ?,
1134 volumeddesc = ?, illus = ?,
1135 pages = ?, notes = ?,
1137 marc = ?, place = ?,
1141 $biblioitemnumber, $biblioitem->{'biblionumber'},
1142 $biblioitem->{'volume'}, $biblioitem->{'number'},
1143 $biblioitem->{'classification'}, $biblioitem->{'itemtype'},
1144 $biblioitem->{'url'}, $biblioitem->{'isbn'},
1145 $biblioitem->{'issn'}, $biblioitem->{'dewey'},
1146 $biblioitem->{'subclass'}, $biblioitem->{'publicationyear'},
1147 $biblioitem->{'publishercode'}, $biblioitem->{'volumedate'},
1148 $biblioitem->{'volumeddesc'}, $biblioitem->{'illus'},
1149 $biblioitem->{'pages'}, $biblioitem->{'bnotes'},
1150 $biblioitem->{'size'}, $biblioitem->{'lccn'},
1151 $biblioitem->{'marc'}, $biblioitem->{'place'},
1152 $biblioitem->{marcxml},
1154 $dbh->do("unlock tables");
1155 zebra_create($biblioitem->{biblionumber}, $record);
1156 return ($biblioitemnumber);
1159 =head2 REALnewsubtitle($dbh,$bibnum,$subtitle);
1163 create a new subtitle
1168 sub REALnewsubtitle {
1169 my ( $dbh, $bibnum, $subtitle ) = @_;
1172 "insert into bibliosubtitle set biblionumber = ?, subtitle = ?");
1173 $sth->execute( $bibnum, $subtitle ) if $subtitle;
1177 =head2 ($itemnumber,$errors)= REALnewitems($dbh,$item,$barcode);
1181 create a item. $item is a hash and $barcode the barcode.
1188 my ( $dbh, $item, $barcode ) = @_;
1190 # warn "OLDNEWITEMS";
1192 $dbh->do('lock tables items WRITE, biblio WRITE,biblioitems WRITE,marc_subfield_structure WRITE');
1193 my $sth = $dbh->prepare("Select max(itemnumber) from items");
1198 $data = $sth->fetchrow_hashref;
1199 $itemnumber = $data->{'max(itemnumber)'} + 1;
1201 # FIXME the "notforloan" field seems to be named "loan" in some places. workaround bugfix.
1202 if ( $item->{'loan'} ) {
1203 $item->{'notforloan'} = $item->{'loan'};
1206 # if dateaccessioned is provided, use it. Otherwise, set to NOW()
1207 if ( $item->{'dateaccessioned'} ) {
1208 $sth = $dbh->prepare( "Insert into items set
1209 itemnumber = ?, biblionumber = ?,
1210 multivolumepart = ?,
1211 biblioitemnumber = ?, barcode = ?,
1212 booksellerid = ?, dateaccessioned = ?,
1213 homebranch = ?, holdingbranch = ?,
1214 price = ?, replacementprice = ?,
1215 replacementpricedate = NOW(), datelastseen = NOW(),
1216 multivolume = ?, stack = ?,
1217 itemlost = ?, wthdrawn = ?,
1218 paidfor = ?, itemnotes = ?,
1219 itemcallnumber =?, notforloan = ?,
1224 $itemnumber, $item->{'biblionumber'},
1225 $item->{'multivolumepart'},
1226 $item->{'biblioitemnumber'},$item->{barcode},
1227 $item->{'booksellerid'}, $item->{'dateaccessioned'},
1228 $item->{'homebranch'}, $item->{'holdingbranch'},
1229 $item->{'price'}, $item->{'replacementprice'},
1230 $item->{multivolume}, $item->{stack},
1231 $item->{itemlost}, $item->{wthdrawn},
1232 $item->{paidfor}, $item->{'itemnotes'},
1233 $item->{'itemcallnumber'}, $item->{'notforloan'},
1236 if ( defined $sth->errstr ) {
1237 $error .= $sth->errstr;
1241 $sth = $dbh->prepare( "Insert into items set
1242 itemnumber = ?, biblionumber = ?,
1243 multivolumepart = ?,
1244 biblioitemnumber = ?, barcode = ?,
1245 booksellerid = ?, dateaccessioned = NOW(),
1246 homebranch = ?, holdingbranch = ?,
1247 price = ?, replacementprice = ?,
1248 replacementpricedate = NOW(), datelastseen = NOW(),
1249 multivolume = ?, stack = ?,
1250 itemlost = ?, wthdrawn = ?,
1251 paidfor = ?, itemnotes = ?,
1252 itemcallnumber =?, notforloan = ?,
1257 $itemnumber, $item->{'biblionumber'},
1258 $item->{'multivolumepart'},
1259 $item->{'biblioitemnumber'},$item->{barcode},
1260 $item->{'booksellerid'},
1261 $item->{'homebranch'}, $item->{'holdingbranch'},
1262 $item->{'price'}, $item->{'replacementprice'},
1263 $item->{multivolume}, $item->{stack},
1264 $item->{itemlost}, $item->{wthdrawn},
1265 $item->{paidfor}, $item->{'itemnotes'},
1266 $item->{'itemcallnumber'}, $item->{'notforloan'},
1269 if ( defined $sth->errstr ) {
1270 $error .= $sth->errstr;
1273 # item stored, now, deal with the marc part...
1274 $sth = $dbh->prepare("select biblioitems.marc,biblio.frameworkcode from biblioitems,biblio
1275 where biblio.biblionumber=biblioitems.biblionumber and
1276 biblio.biblionumber=?");
1277 $sth->execute($item->{biblionumber});
1278 if ( defined $sth->errstr ) {
1279 $error .= $sth->errstr;
1281 my ($rawmarc,$frameworkcode) = $sth->fetchrow;
1282 warn "ERROR IN REALnewitem, MARC record not found FOR $item->{biblionumber} => $rawmarc <=" unless $rawmarc;
1283 my $record = MARC::File::USMARC::decode($rawmarc);
1284 # ok, we have the marc record, add item number to the item field (in {marc}, and add the field to the record)
1285 my ($itemnumberfield,$itemnumbersubfield) = MARCfind_marc_from_kohafield($dbh,'items.itemnumber',$frameworkcode);
1286 my $itemrecord = MARC::File::USMARC::decode($item->{marc});
1287 my $itemfield = $itemrecord->field($itemnumberfield);
1288 $itemfield->add_subfields($itemnumbersubfield => "$itemnumber");
1289 $record->insert_grouped_field($itemfield);
1290 # save the record into biblioitem
1291 $sth=$dbh->prepare("update biblioitems set marc=?,marcxml=? where biblionumber=?");
1292 $sth->execute($record->as_usmarc(),$record->as_xml(),$item->{biblionumber});
1293 if ( defined $sth->errstr ) {
1294 $error .= $sth->errstr;
1296 zebra_create($item->{biblionumber},$record);
1297 $dbh->do('unlock tables');
1298 return ( $itemnumber, $error );
1301 =head2 REALmoditem($dbh,$item);
1312 my ( $dbh, $item ) = @_;
1314 $dbh->do('lock tables items WRITE, biblio WRITE,biblioitems WRITE');
1315 $item->{'itemnum'} = $item->{'itemnumber'} unless $item->{'itemnum'};
1316 my $query = "update items set barcode=?,itemnotes=?,itemcallnumber=?,notforloan=?,location=?,multivolumepart=?,multivolume=?,stack=?,wthdrawn=?";
1318 $item->{'barcode'}, $item->{'notes'},
1319 $item->{'itemcallnumber'}, $item->{'notforloan'},
1320 $item->{'location'}, $item->{multivolumepart},
1321 $item->{multivolume}, $item->{stack},
1324 if ( $item->{'lost'} ne '' ) {
1325 $query = "update items set biblioitemnumber=?,barcode=?,itemnotes=?,homebranch=?,
1326 itemlost=?,wthdrawn=?,itemcallnumber=?,notforloan=?,
1327 location=?,multivolumepart=?,multivolume=?,stack=?,wthdrawn=?";
1329 $item->{'bibitemnum'}, $item->{'barcode'},
1330 $item->{'notes'}, $item->{'homebranch'},
1331 $item->{'lost'}, $item->{'wthdrawn'},
1332 $item->{'itemcallnumber'}, $item->{'notforloan'},
1333 $item->{'location'}, $item->{multivolumepart},
1334 $item->{multivolume}, $item->{stack},
1337 if ($item->{homebranch}) {
1338 $query.=",homebranch=?";
1339 push @bind, $item->{homebranch};
1341 if ($item->{holdingbranch}) {
1342 $query.=",holdingbranch=?";
1343 push @bind, $item->{holdingbranch};
1346 $query.=" where itemnumber=?";
1347 push @bind,$item->{'itemnum'};
1348 if ( $item->{'replacement'} ne '' ) {
1349 $query =~ s/ where/,replacementprice='$item->{'replacement'}' where/;
1351 my $sth = $dbh->prepare($query);
1352 $sth->execute(@bind);
1354 # item stored, now, deal with the marc part...
1355 $sth = $dbh->prepare("select biblioitems.marc,biblio.frameworkcode from biblioitems,biblio
1356 where biblio.biblionumber=biblioitems.biblionumber and
1357 biblio.biblionumber=? and
1358 biblioitems.biblioitemnumber=?");
1359 $sth->execute($item->{biblionumber},$item->{biblioitemnumber});
1360 if ( defined $sth->errstr ) {
1361 $error .= $sth->errstr;
1363 my ($rawmarc,$frameworkcode) = $sth->fetchrow;
1364 warn "ERROR IN REALmoditem, MARC record not found" unless $rawmarc;
1365 my $record = MARC::File::USMARC::decode($rawmarc);
1366 # ok, we have the marc record, find the previous item record for this itemnumber and delete it
1367 my ($itemnumberfield,$itemnumbersubfield) = MARCfind_marc_from_kohafield($dbh,'items.itemnumber',$frameworkcode);
1368 # prepare the new item record
1369 my $itemrecord = MARC::File::USMARC::decode($item->{marc});
1370 my $itemfield = $itemrecord->field($itemnumberfield);
1371 $itemfield->add_subfields($itemnumbersubfield => '$itemnumber');
1372 # parse all fields fields from the complete record
1373 foreach ($record->field($itemnumberfield)) {
1374 # when the previous field is found, replace by the new one
1375 if ($_->subfield($itemnumbersubfield) == $item->{itemnum}) {
1376 $_->replace_with($itemfield);
1379 # $record->insert_grouped_field($itemfield);
1380 # save the record into biblioitem
1381 $sth=$dbh->prepare("update biblioitems set marc=?,marcxml=? where biblionumber=? and biblioitemnumber=?");
1382 $sth->execute($record->as_usmarc(),$record->as_xml(),$item->{biblionumber},$item->{biblioitemnumber});
1383 zebra_create($item->biblionumber,$record);
1384 if ( defined $sth->errstr ) {
1385 $error .= $sth->errstr;
1387 $dbh->do('unlock tables');
1392 =head2 REALdelitem($dbh,$itemnum);
1403 my ( $dbh, $itemnum ) = @_;
1405 # my $dbh=C4Connect;
1406 my $sth = $dbh->prepare("select * from items where itemnumber=?");
1407 $sth->execute($itemnum);
1408 my $data = $sth->fetchrow_hashref;
1410 my $query = "Insert into deleteditems set ";
1412 foreach my $temp ( keys %$data ) {
1413 $query .= "$temp = ?,";
1414 push ( @bind, $data->{$temp} );
1419 $sth = $dbh->prepare($query);
1420 $sth->execute(@bind);
1422 $sth = $dbh->prepare("Delete from items where itemnumber=?");
1423 $sth->execute($itemnum);
1429 =head2 REALdelbiblioitem($dbh,$biblioitemnumber);
1433 deletes a biblioitem
1434 NOTE : not standard sub name. Should be REALdelbiblioitem()
1440 sub REALdelbiblioitem {
1441 my ( $dbh, $biblioitemnumber ) = @_;
1443 # my $dbh = C4Connect;
1444 my $sth = $dbh->prepare( "Select * from biblioitems
1445 where biblioitemnumber = ?"
1449 $sth->execute($biblioitemnumber);
1451 if ( $results = $sth->fetchrow_hashref ) {
1455 "Insert into deletedbiblioitems (biblioitemnumber, biblionumber, volume, number, classification, itemtype,
1456 isbn, issn ,dewey ,subclass ,publicationyear ,publishercode ,volumedate ,volumeddesc ,timestamp ,illus ,
1457 pages ,notes ,size ,url ,lccn ) values(?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)"
1461 $results->{biblioitemnumber}, $results->{biblionumber},
1462 $results->{volume}, $results->{number},
1463 $results->{classification}, $results->{itemtype},
1464 $results->{isbn}, $results->{issn},
1465 $results->{dewey}, $results->{subclass},
1466 $results->{publicationyear}, $results->{publishercode},
1467 $results->{volumedate}, $results->{volumeddesc},
1468 $results->{timestamp}, $results->{illus},
1469 $results->{pages}, $results->{notes},
1470 $results->{size}, $results->{url},
1474 $dbh->prepare("Delete from biblioitems where biblioitemnumber = ?");
1475 $sth2->execute($biblioitemnumber);
1480 # Now delete all the items attached to the biblioitem
1481 $sth = $dbh->prepare("Select * from items where biblioitemnumber = ?");
1482 $sth->execute($biblioitemnumber);
1484 while ( my $data = $sth->fetchrow_hashref ) {
1485 my $query = "Insert into deleteditems set ";
1487 foreach my $temp ( keys %$data ) {
1488 $query .= "$temp = ?,";
1489 push ( @bind, $data->{$temp} );
1492 my $sth2 = $dbh->prepare($query);
1493 $sth2->execute(@bind);
1496 $sth = $dbh->prepare("Delete from items where biblioitemnumber = ?");
1497 $sth->execute($biblioitemnumber);
1501 } # sub deletebiblioitem
1503 =head2 REALdelbiblio($dbh,$biblio);
1514 my ( $dbh, $biblio ) = @_;
1515 my $sth = $dbh->prepare("select * from biblio where biblionumber=?");
1516 $sth->execute($biblio);
1517 if ( my $data = $sth->fetchrow_hashref ) {
1519 my $query = "Insert into deletedbiblio set ";
1521 foreach my $temp ( keys %$data ) {
1522 $query .= "$temp = ?,";
1523 push ( @bind, $data->{$temp} );
1526 #replacing the last , by ",?)"
1528 $sth = $dbh->prepare($query);
1529 $sth->execute(@bind);
1531 $sth = $dbh->prepare("Delete from biblio where biblionumber=?");
1532 $sth->execute($biblio);
1538 =head2 $number = itemcount($biblio);
1542 returns the number of items attached to a biblio
1550 my $dbh = C4::Context->dbh;
1553 my $sth = $dbh->prepare("Select count(*) from items where biblionumber=?");
1554 $sth->execute($biblio);
1555 my $data = $sth->fetchrow_hashref;
1557 return ( $data->{'count(*)'} );
1560 =head2 $biblionumber = newbiblio($biblio);
1564 create a biblio. The parameter is a hash
1572 my $dbh = C4::Context->dbh;
1573 my $bibnum = REALnewbiblio( $dbh, $biblio );
1574 # finds new (MARC bibid
1575 # my $bibid = &MARCfind_MARCbibid_from_oldbiblionumber($dbh,$bibnum);
1576 # my $record = &MARCkoha2marcBiblio( $dbh, $bibnum );
1577 # MARCaddbiblio( $dbh, $record, $bibnum,'' );
1581 =head2 $biblionumber = &modbiblio($biblio);
1585 Update a biblio record.
1587 C<$biblio> is a reference-to-hash whose keys are the fields in the
1588 biblio table in the Koha database. All fields must be present, not
1589 just the ones you wish to change.
1591 C<&modbiblio> updates the record defined by
1592 C<$biblio-E<gt>{biblionumber}> with the values in C<$biblio>.
1594 C<&modbiblio> returns C<$biblio-E<gt>{biblionumber}> whether it was
1603 my $dbh = C4::Context->dbh;
1604 my $biblionumber=REALmodbiblio($dbh,$biblio);
1605 my $record = MARCkoha2marcBiblio($dbh,$biblionumber,$biblionumber);
1606 # finds new (MARC bibid
1607 my $bibid = &MARCfind_MARCbibid_from_oldbiblionumber($dbh,$biblionumber);
1608 MARCmodbiblio($dbh,$bibid,$record,"",0);
1609 return($biblionumber);
1612 =head2 &modsubtitle($biblionumber, $subtitle);
1616 Sets the subtitle of a book.
1618 C<$biblionumber> is the biblionumber of the book to modify.
1620 C<$subtitle> is the new subtitle.
1627 my ( $bibnum, $subtitle ) = @_;
1628 my $dbh = C4::Context->dbh;
1629 &REALmodsubtitle( $dbh, $bibnum, $subtitle );
1632 =head2 &modaddauthor($biblionumber, $author);
1636 Replaces all additional authors for the book with biblio number
1637 C<$biblionumber> with C<$author>. If C<$author> is the empty string,
1638 C<&modaddauthor> deletes all additional authors.
1645 my ( $bibnum, @authors ) = @_;
1646 my $dbh = C4::Context->dbh;
1647 &REALmodaddauthor( $dbh, $bibnum, @authors );
1648 } # sub modaddauthor
1650 =head2 $error = &modsubject($biblionumber, $force, @subjects);
1654 $force - a subject to force
1655 $error - Error message, or undef if successful.
1662 my ( $bibnum, $force, @subject ) = @_;
1663 my $dbh = C4::Context->dbh;
1664 my $error = &REALmodsubject( $dbh, $bibnum, $force, @subject );
1666 # When MARC is off, ensures that the MARC biblio table gets updated with new
1667 # subjects, of course, it deletes the biblio in marc, and then recreates.
1668 # This check is to ensure that no MARC data exists to lose.
1669 # if (C4::Context->preference("MARC") eq '0'){
1670 # warn "in modSUBJECT";
1671 # my $MARCRecord = &MARCkoha2marcBiblio($dbh,$bibnum);
1672 # my $bibid = &MARCfind_MARCbibid_from_oldbiblionumber($dbh,$bibnum);
1673 # &MARCmodbiblio($dbh,$bibid, $MARCRecord);
1679 =head2 modbibitem($biblioitem);
1683 modify a biblioitem. The parameter is a hash
1690 my ($biblioitem) = @_;
1691 my $dbh = C4::Context->dbh;
1692 &REALmodbiblioitem( $dbh, $biblioitem );
1695 =head2 $biblioitemnumber = newbiblioitem($biblioitem)
1699 create a biblioitem, the parameter is a hash
1706 my ($biblioitem) = @_;
1707 my $dbh = C4::Context->dbh;
1708 # add biblio information to the hash
1709 my $MARCbiblio = MARCkoha2marcBiblio( $dbh, $biblioitem );
1710 $biblioitem->{marc} = $MARCbiblio->as_usmarc();
1711 my $bibitemnum = &REALnewbiblioitem( $dbh, $biblioitem );
1712 return ($bibitemnum);
1715 =head2 newsubtitle($biblionumber,$subtitle);
1719 insert a subtitle for $biblionumber biblio
1727 my ( $bibnum, $subtitle ) = @_;
1728 my $dbh = C4::Context->dbh;
1729 &REALnewsubtitle( $dbh, $bibnum, $subtitle );
1732 =head2 $errors = newitems($item, @barcodes);
1736 insert items ($item is a hash)
1744 my ( $item, @barcodes ) = @_;
1745 my $dbh = C4::Context->dbh;
1749 foreach my $barcode (@barcodes) {
1750 # add items, one by one for each barcode.
1752 $oneitem->{barcode}= $barcode;
1753 my $MARCitem = &MARCkoha2marcItem( $dbh, $oneitem);
1754 $oneitem->{marc} = $MARCitem->as_usmarc;
1755 ( $itemnumber, $error ) = &REALnewitems( $dbh, $oneitem);
1756 # $errors .= $error;
1757 # &MARCadditem( $dbh, $MARCitem, $item->{biblionumber} );
1762 =head2 moditem($item);
1766 modify an item ($item is a hash with all item informations)
1775 my $dbh = C4::Context->dbh;
1776 &REALmoditem( $dbh, $item );
1778 &MARCkoha2marcItem( $dbh, $item->{'biblionumber'}, $item->{'itemnum'} );
1780 &MARCfind_MARCbibid_from_oldbiblionumber( $dbh, $item->{biblionumber} );
1781 &MARCmoditem( $dbh, $MARCitem, $bibid, $item->{itemnum}, 0 );
1784 =head2 $error = checkitems($count,@barcodes);
1788 check for each @barcode entry that the barcode is not a duplicate
1795 my ( $count, @barcodes ) = @_;
1796 my $dbh = C4::Context->dbh;
1798 my $sth = $dbh->prepare("Select * from items where barcode=?");
1799 for ( my $i = 0 ; $i < $count ; $i++ ) {
1800 $barcodes[$i] = uc $barcodes[$i];
1801 $sth->execute( $barcodes[$i] );
1802 if ( my $data = $sth->fetchrow_hashref ) {
1803 $error .= " Duplicate Barcode: $barcodes[$i]";
1810 =head2 $delitem($itemnum);
1814 delete item $itemnum being the item number to delete
1822 my $dbh = C4::Context->dbh;
1823 &REALdelitem( $dbh, $itemnum );
1826 =head2 deletebiblioitem($biblioitemnumber);
1830 delete the biblioitem $biblioitemnumber
1836 sub deletebiblioitem {
1837 my ($biblioitemnumber) = @_;
1838 my $dbh = C4::Context->dbh;
1839 &REALdelbiblioitem( $dbh, $biblioitemnumber );
1840 } # sub deletebiblioitem
1842 =head2 delbiblio($biblionumber)
1846 delete biblio $biblionumber
1854 my $dbh = C4::Context->dbh;
1855 &REALdelbiblio( $dbh, $biblio );
1856 my $bibid = &MARCfind_MARCbibid_from_oldbiblionumber( $dbh, $biblio );
1857 &MARCdelbiblio( $dbh, $bibid, 0 );
1860 =head2 ($count,@results) = getbiblio($biblionumber);
1864 return an array with hash of biblios.
1866 FIXME : biblionumber being the primary key, this sub will always return only 1 result, API should be modified...
1873 my ($biblionumber) = @_;
1874 my $dbh = C4::Context->dbh;
1875 my $sth = $dbh->prepare("Select * from biblio where biblionumber = ?");
1877 # || die "Cannot prepare $query\n" . $dbh->errstr;
1881 $sth->execute($biblionumber);
1883 # || die "Cannot execute $query\n" . $sth->errstr;
1884 while ( my $data = $sth->fetchrow_hashref ) {
1885 $results[$count] = $data;
1890 return ( $count, @results );
1895 $data = &bibdata($biblionumber, $type);
1897 Returns information about the book with the given biblionumber.
1899 C<$type> is ignored.
1901 C<&bibdata> returns a reference-to-hash. The keys are the fields in
1902 the C<biblio>, C<biblioitems>, and C<bibliosubtitle> tables in the
1905 In addition, C<$data-E<gt>{subject}> is the list of the book's
1906 subjects, separated by C<" , "> (space, comma, space).
1908 If there are multiple biblioitems with the given biblionumber, only
1909 the first one is considered.
1914 my ($bibnum, $type) = @_;
1915 my $dbh = C4::Context->dbh;
1916 my $sth = $dbh->prepare("Select *, biblioitems.notes AS bnotes, biblio.notes
1918 left join biblioitems on biblioitems.biblionumber = biblio.biblionumber
1919 left join bibliosubtitle on
1920 biblio.biblionumber = bibliosubtitle.biblionumber
1921 left join itemtypes on biblioitems.itemtype=itemtypes.itemtype
1922 where biblio.biblionumber = ?
1924 $sth->execute($bibnum);
1926 $data = $sth->fetchrow_hashref;
1928 # handle management of repeated subtitle
1929 $sth = $dbh->prepare("Select * from bibliosubtitle where biblionumber = ?");
1930 $sth->execute($bibnum);
1932 while (my $dat = $sth->fetchrow_hashref){
1934 $line{subtitle} = $dat->{subtitle};
1935 push @subtitles, \%line;
1937 $data->{subtitles} = \@subtitles;
1939 $sth = $dbh->prepare("Select * from bibliosubject where biblionumber = ?");
1940 $sth->execute($bibnum);
1942 while (my $dat = $sth->fetchrow_hashref){
1944 $line{subject} = $dat->{'subject'};
1945 push @subjects, \%line;
1947 $data->{subjects} = \@subjects;
1949 $sth = $dbh->prepare("Select * from additionalauthors where biblionumber = ?");
1950 $sth->execute($bibnum);
1951 while (my $dat = $sth->fetchrow_hashref){
1952 $data->{'additionalauthors'} .= "$dat->{'author'} - ";
1954 chop $data->{'additionalauthors'};
1955 chop $data->{'additionalauthors'};
1956 chop $data->{'additionalauthors'};
1961 =head2 ($count,@results) = getbiblioitem($biblioitemnumber);
1965 return an array with hash of biblioitemss.
1967 FIXME : biblioitemnumber being unique, this sub will always return only 1 result, API should be modified...
1974 my ($biblioitemnum) = @_;
1975 my $dbh = C4::Context->dbh;
1976 my $sth = $dbh->prepare( "Select * from biblioitems where
1977 biblioitemnumber = ?"
1982 $sth->execute($biblioitemnum);
1984 while ( my $data = $sth->fetchrow_hashref ) {
1985 $results[$count] = $data;
1990 return ( $count, @results );
1991 } # sub getbiblioitem
1993 =head2 ($count,@results) = getbiblioitembybiblionumber($biblionumber);
1997 return an array with hash of biblioitems for the given biblionumber.
2003 sub getbiblioitembybiblionumber {
2004 my ($biblionumber) = @_;
2005 my $dbh = C4::Context->dbh;
2006 my $sth = $dbh->prepare("Select * from biblioitems where biblionumber = ?");
2010 $sth->execute($biblionumber);
2012 while ( my $data = $sth->fetchrow_hashref ) {
2013 $results[$count] = $data;
2018 return ( $count, @results );
2021 =head2 ($count,@results) = getitemsbybiblioitem($biblionumber);
2025 returns an array with hash of items
2031 sub getitemsbybiblioitem {
2032 my ($biblioitemnum) = @_;
2033 my $dbh = C4::Context->dbh;
2034 my $sth = $dbh->prepare( "Select * from items, biblio where
2035 biblio.biblionumber = items.biblionumber and biblioitemnumber
2039 # || die "Cannot prepare $query\n" . $dbh->errstr;
2043 $sth->execute($biblioitemnum);
2045 # || die "Cannot execute $query\n" . $sth->errstr;
2046 while ( my $data = $sth->fetchrow_hashref ) {
2047 $results[$count] = $data;
2052 return ( $count, @results );
2053 } # sub getitemsbybiblioitem
2057 @results = &ItemInfo($env, $biblionumber, $type);
2059 Returns information about books with the given biblionumber.
2061 C<$type> may be either C<intra> or anything else. If it is not set to
2062 C<intra>, then the search will exclude lost, very overdue, and
2067 C<&ItemInfo> returns a list of references-to-hash. Each element
2068 contains a number of keys. Most of them are table items from the
2069 C<biblio>, C<biblioitems>, C<items>, and C<itemtypes> tables in the
2070 Koha database. Other keys include:
2074 =item C<$data-E<gt>{branchname}>
2076 The name (not the code) of the branch to which the book belongs.
2078 =item C<$data-E<gt>{datelastseen}>
2080 This is simply C<items.datelastseen>, except that while the date is
2081 stored in YYYY-MM-DD format in the database, here it is converted to
2082 DD/MM/YYYY format. A NULL date is returned as C<//>.
2084 =item C<$data-E<gt>{datedue}>
2086 =item C<$data-E<gt>{class}>
2088 This is the concatenation of C<biblioitems.classification>, the book's
2089 Dewey code, and C<biblioitems.subclass>.
2091 =item C<$data-E<gt>{ocount}>
2093 I think this is the number of copies of the book available.
2095 =item C<$data-E<gt>{order}>
2097 If this is set, it is set to C<One Order>.
2104 my ($env,$biblionumber,$type) = @_;
2105 my $dbh = C4::Context->dbh;
2106 my $query = "SELECT *,items.notforloan as itemnotforloan FROM items, biblio, biblioitems
2107 left join itemtypes on biblioitems.itemtype = itemtypes.itemtype
2108 WHERE items.biblionumber = ?
2109 AND biblioitems.biblioitemnumber = items.biblioitemnumber
2110 AND biblio.biblionumber = items.biblionumber";
2111 $query .= " order by items.dateaccessioned desc";
2112 my $sth=$dbh->prepare($query);
2113 $sth->execute($biblionumber);
2116 while (my $data=$sth->fetchrow_hashref){
2118 my $isth=$dbh->prepare("Select issues.*,borrowers.cardnumber from issues,borrowers where itemnumber = ? and returndate is null and issues.borrowernumber=borrowers.borrowernumber");
2119 $isth->execute($data->{'itemnumber'});
2120 if (my $idata=$isth->fetchrow_hashref){
2121 $data->{borrowernumber} = $idata->{borrowernumber};
2122 $data->{cardnumber} = $idata->{cardnumber};
2123 $datedue = format_date($idata->{'date_due'});
2125 if ($datedue eq ''){
2126 my ($restype,$reserves)=C4::Reserves2::CheckReserves($data->{'itemnumber'});
2132 #get branch information.....
2133 my $bsth=$dbh->prepare("SELECT * FROM branches WHERE branchcode = ?");
2134 $bsth->execute($data->{'holdingbranch'});
2135 if (my $bdata=$bsth->fetchrow_hashref){
2136 $data->{'branchname'} = $bdata->{'branchname'};
2138 my $date=format_date($data->{'datelastseen'});
2139 $data->{'datelastseen'}=$date;
2140 $data->{'datedue'}=$datedue;
2141 # get notforloan complete status if applicable
2142 my $sthnflstatus = $dbh->prepare('select authorised_value from marc_subfield_structure where kohafield="items.notforloan"');
2143 $sthnflstatus->execute;
2144 my ($authorised_valuecode) = $sthnflstatus->fetchrow;
2145 if ($authorised_valuecode) {
2146 $sthnflstatus = $dbh->prepare("select lib from authorised_values where category=? and authorised_value=?");
2147 $sthnflstatus->execute($authorised_valuecode,$data->{itemnotforloan});
2148 my ($lib) = $sthnflstatus->fetchrow;
2149 $data->{notforloan} = $lib;
2160 ($count, @results) = &bibitems($biblionumber);
2162 Given the biblionumber for a book, C<&bibitems> looks up that book's
2163 biblioitems (different publications of the same book, the audio book
2164 and film versions, etc.).
2166 C<$count> is the number of elements in C<@results>.
2168 C<@results> is an array of references-to-hash; the keys are the fields
2169 of the C<biblioitems> and C<itemtypes> tables of the Koha database. In
2170 addition, C<itemlost> indicates the availability of the item: if it is
2171 "2", then all copies of the item are long overdue; if it is "1", then
2172 all copies are lost; otherwise, there is at least one copy available.
2178 my $dbh = C4::Context->dbh;
2179 my $sth = $dbh->prepare("SELECT biblioitems.*,
2181 MIN(items.itemlost) as itemlost,
2182 MIN(items.dateaccessioned) as dateaccessioned
2183 FROM biblioitems, itemtypes, items
2184 WHERE biblioitems.biblionumber = ?
2185 AND biblioitems.itemtype = itemtypes.itemtype
2186 AND biblioitems.biblioitemnumber = items.biblioitemnumber
2187 GROUP BY items.biblioitemnumber");
2190 $sth->execute($bibnum);
2191 while (my $data = $sth->fetchrow_hashref) {
2192 $results[$count] = $data;
2196 return($count, @results);
2202 $itemdata = &bibitemdata($biblioitemnumber);
2204 Looks up the biblioitem with the given biblioitemnumber. Returns a
2205 reference-to-hash. The keys are the fields from the C<biblio>,
2206 C<biblioitems>, and C<itemtypes> tables in the Koha database, except
2207 that C<biblioitems.notes> is given as C<$itemdata-E<gt>{bnotes}>.
2213 my $dbh = C4::Context->dbh;
2214 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");
2217 $sth->execute($bibitem);
2219 $data = $sth->fetchrow_hashref;
2226 =item getbibliofromitemnumber
2228 $item = &getbibliofromitemnumber($env, $dbh, $itemnumber);
2230 Looks up the item with the given itemnumber.
2232 C<$env> and C<$dbh> are ignored.
2234 C<&itemnodata> returns a reference-to-hash whose keys are the fields
2235 from the C<biblio>, C<biblioitems>, and C<items> tables in the Koha
2240 sub getbibliofromitemnumber {
2241 my ($env,$dbh,$itemnumber) = @_;
2242 $dbh = C4::Context->dbh;
2243 my $sth=$dbh->prepare("Select * from biblio,items,biblioitems
2244 where items.itemnumber = ?
2245 and biblio.biblionumber = items.biblionumber
2246 and biblioitems.biblioitemnumber = items.biblioitemnumber");
2248 $sth->execute($itemnumber);
2249 my $data=$sth->fetchrow_hashref;
2256 @barcodes = &barcodes($biblioitemnumber);
2258 Given a biblioitemnumber, looks up the corresponding items.
2260 Returns an array of references-to-hash; the keys are C<barcode> and
2263 The returned items include very overdue items, but not lost ones.
2268 #called from request.pl
2269 my ($biblioitemnumber)=@_;
2270 my $dbh = C4::Context->dbh;
2271 my $sth=$dbh->prepare("SELECT barcode, itemlost, holdingbranch FROM items
2272 WHERE biblioitemnumber = ?
2273 AND (wthdrawn <> 1 OR wthdrawn IS NULL)");
2274 $sth->execute($biblioitemnumber);
2277 while (my $data=$sth->fetchrow_hashref){
2278 $barcodes[$i]=$data;
2288 $item = &itemdata($barcode);
2290 Looks up the item with the given barcode, and returns a
2291 reference-to-hash containing information about that item. The keys of
2292 the hash are the fields from the C<items> and C<biblioitems> tables in
2297 sub get_item_from_barcode {
2299 my $dbh = C4::Context->dbh;
2300 my $sth=$dbh->prepare("Select * from items,biblioitems where barcode=?
2301 and items.biblioitemnumber=biblioitems.biblioitemnumber");
2302 $sth->execute($barcode);
2303 my $data=$sth->fetchrow_hashref;
2311 @issues = &itemissues($biblioitemnumber, $biblio);
2313 Looks up information about who has borrowed the bookZ<>(s) with the
2314 given biblioitemnumber.
2316 C<$biblio> is ignored.
2318 C<&itemissues> returns an array of references-to-hash. The keys
2319 include the fields from the C<items> table in the Koha database.
2320 Additional keys include:
2326 If the item is currently on loan, this gives the due date.
2328 If the item is not on loan, then this is either "Available" or
2329 "Cancelled", if the item has been withdrawn.
2333 If the item is currently on loan, this gives the card number of the
2334 patron who currently has the item.
2336 =item C<timestamp0>, C<timestamp1>, C<timestamp2>
2338 These give the timestamp for the last three times the item was
2341 =item C<card0>, C<card1>, C<card2>
2343 The card number of the last three patrons who borrowed this item.
2345 =item C<borrower0>, C<borrower1>, C<borrower2>
2347 The borrower number of the last three patrons who borrowed this item.
2354 my ($bibitem, $biblio)=@_;
2355 my $dbh = C4::Context->dbh;
2356 # FIXME - If this function die()s, the script will abort, and the
2357 # user won't get anything; depending on how far the script has
2358 # gotten, the user might get a blank page. It would be much better
2359 # to at least print an error message. The easiest way to do this
2360 # is to set $SIG{__DIE__}.
2361 my $sth = $dbh->prepare("Select * from items where
2362 items.biblioitemnumber = ?")
2363 || die $dbh->errstr;
2367 $sth->execute($bibitem)
2368 || die $sth->errstr;
2370 while (my $data = $sth->fetchrow_hashref) {
2371 # Find out who currently has this item.
2372 # FIXME - Wouldn't it be better to do this as a left join of
2373 # some sort? Currently, this code assumes that if
2374 # fetchrow_hashref() fails, then the book is on the shelf.
2375 # fetchrow_hashref() can fail for any number of reasons (e.g.,
2376 # database server crash), not just because no items match the
2378 my $sth2 = $dbh->prepare("select * from issues,borrowers
2379 where itemnumber = ?
2380 and returndate is NULL
2381 and issues.borrowernumber = borrowers.borrowernumber");
2383 $sth2->execute($data->{'itemnumber'});
2384 if (my $data2 = $sth2->fetchrow_hashref) {
2385 $data->{'date_due'} = $data2->{'date_due'};
2386 $data->{'card'} = $data2->{'cardnumber'};
2387 $data->{'borrower'} = $data2->{'borrowernumber'};
2389 if ($data->{'wthdrawn'} eq '1') {
2390 $data->{'date_due'} = 'Cancelled';
2392 $data->{'date_due'} = 'Available';
2398 # Find the last 3 people who borrowed this item.
2399 $sth2 = $dbh->prepare("select * from issues, borrowers
2400 where itemnumber = ?
2401 and issues.borrowernumber = borrowers.borrowernumber
2402 and returndate is not NULL
2403 order by returndate desc,timestamp desc") || die $dbh->errstr;
2404 $sth2->execute($data->{'itemnumber'}) || die $sth2->errstr;
2405 for (my $i2 = 0; $i2 < 2; $i2++) { # FIXME : error if there is less than 3 pple borrowing this item
2406 if (my $data2 = $sth2->fetchrow_hashref) {
2407 $data->{"timestamp$i2"} = $data2->{'timestamp'};
2408 $data->{"card$i2"} = $data2->{'cardnumber'};
2409 $data->{"borrower$i2"} = $data2->{'borrowernumber'};
2414 $results[$i] = $data;
2424 ($count, $subjects) = &getsubject($biblionumber);
2426 Looks up the subjects of the book with the given biblionumber. Returns
2427 a two-element list. C<$subjects> is a reference-to-array, where each
2428 element is a subject of the book, and C<$count> is the number of
2429 elements in C<$subjects>.
2435 my $dbh = C4::Context->dbh;
2436 my $sth=$dbh->prepare("Select * from bibliosubject where biblionumber=?");
2437 $sth->execute($bibnum);
2440 while (my $data=$sth->fetchrow_hashref){
2445 return($i,\@results);
2450 ($count, $authors) = &getaddauthor($biblionumber);
2452 Looks up the additional authors for the book with the given
2455 Returns a two-element list. C<$authors> is a reference-to-array, where
2456 each element is an additional author, and C<$count> is the number of
2457 elements in C<$authors>.
2463 my $dbh = C4::Context->dbh;
2464 my $sth=$dbh->prepare("Select * from additionalauthors where biblionumber=?");
2465 $sth->execute($bibnum);
2468 while (my $data=$sth->fetchrow_hashref){
2473 return($i,\@results);
2479 ($count, $subtitles) = &getsubtitle($biblionumber);
2481 Looks up the subtitles for the book with the given biblionumber.
2483 Returns a two-element list. C<$subtitles> is a reference-to-array,
2484 where each element is a subtitle, and C<$count> is the number of
2485 elements in C<$subtitles>.
2491 my $dbh = C4::Context->dbh;
2492 my $sth=$dbh->prepare("Select * from bibliosubtitle where biblionumber=?");
2493 $sth->execute($bibnum);
2496 while (my $data=$sth->fetchrow_hashref){
2501 return($i,\@results);
2507 ($count, @websites) = &getwebsites($biblionumber);
2509 Looks up the web sites pertaining to the book with the given
2512 C<$count> is the number of elements in C<@websites>.
2514 C<@websites> is an array of references-to-hash; the keys are the
2515 fields from the C<websites> table in the Koha database.
2518 #FIXME : could maybe be deleted. Otherwise, would be better in a Websites.pm package
2519 #(with add / modify / delete subs)
2522 my ($biblionumber) = @_;
2523 my $dbh = C4::Context->dbh;
2524 my $sth = $dbh->prepare("Select * from websites where biblionumber = ?");
2528 $sth->execute($biblionumber);
2529 while (my $data = $sth->fetchrow_hashref) {
2530 # FIXME - The URL scheme shouldn't be stripped off, at least
2531 # not here, since it's part of the URL, and will be useful in
2532 # constructing a link to the site. If you don't want the user
2533 # to see the "http://" part, strip that off when building the
2535 $data->{'url'} =~ s/^http:\/\///; # FIXME - Leaning toothpick
2537 $results[$count] = $data;
2542 return($count, @results);
2545 =item getwebbiblioitems
2547 ($count, @results) = &getwebbiblioitems($biblionumber);
2549 Given a book's biblionumber, looks up the web versions of the book
2550 (biblioitems with itemtype C<WEB>).
2552 C<$count> is the number of items in C<@results>. C<@results> is an
2553 array of references-to-hash; the keys are the items from the
2554 C<biblioitems> table of the Koha database.
2558 sub getwebbiblioitems {
2559 my ($biblionumber) = @_;
2560 my $dbh = C4::Context->dbh;
2561 my $sth = $dbh->prepare("Select * from biblioitems where biblionumber = ?
2562 and itemtype = 'WEB'");
2566 $sth->execute($biblionumber);
2567 while (my $data = $sth->fetchrow_hashref) {
2568 $data->{'url'} =~ s/^http:\/\///;
2569 $results[$count] = $data;
2574 return($count, @results);
2575 } # sub getwebbiblioitems
2579 # converts ISO 5426 coded string to ISO 8859-1
2580 # sloppy code : should be improved in next issue
2581 my ( $string, $encoding ) = @_;
2584 # $encoding = C4::Context->preference("marcflavour") unless $encoding;
2585 if ( $encoding eq "UNIMARC" ) {
2654 # this handles non-sorting blocks (if implementation requires this)
2655 $string = nsb_clean($_);
2657 elsif ( $encoding eq "USMARC" || $encoding eq "MARC21" ) {
2658 if (/[\xc1-\xff]/) {
2711 # this handles non-sorting blocks (if implementation requires this)
2712 $string = nsb_clean($_);
2719 my $NSB = '\x88'; # NSB : begin Non Sorting Block
2720 my $NSE = '\x89'; # NSE : Non Sorting Block end
2721 # handles non sorting blocks
2725 s/[ ]{0,1}$NSE/) /gm;
2732 my $dbh = C4::Context->dbh;
2733 my $result = MARCmarc2koha($dbh,$record,'');
2735 my ($biblionumber,$bibid,$title);
2736 # search duplicate on ISBN, easy and fast...
2737 if ($result->{isbn}) {
2738 $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=?");
2739 $sth->execute($result->{'isbn'});
2740 ($biblionumber,$bibid,$title) = $sth->fetchrow;
2741 return $biblionumber,$bibid,$title if ($biblionumber);
2743 # a more complex search : build a request for SearchMarc::catalogsearch()
2744 my (@tags, @and_or, @excluding, @operator, @value, $offset,$length);
2745 # search on biblio.title
2746 my ($tag,$subfield) = MARCfind_marc_from_kohafield($dbh,"biblio.title","");
2747 if ($record->field($tag)) {
2748 if ($record->field($tag)->subfields($subfield)) {
2749 push @tags, "'".$tag.$subfield."'";
2750 push @and_or, "and";
2751 push @excluding, "";
2752 push @operator, "contains";
2753 push @value, $record->field($tag)->subfield($subfield);
2754 # warn "for title, I add $tag / $subfield".$record->field($tag)->subfield($subfield);
2757 # ... and on biblio.author
2758 ($tag,$subfield) = MARCfind_marc_from_kohafield($dbh,"biblio.author","");
2759 if ($record->field($tag)) {
2760 if ($record->field($tag)->subfields($subfield)) {
2761 push @tags, "'".$tag.$subfield."'";
2762 push @and_or, "and";
2763 push @excluding, "";
2764 push @operator, "contains";
2765 push @value, $record->field($tag)->subfield($subfield);
2766 # warn "for author, I add $tag / $subfield".$record->field($tag)->subfield($subfield);
2769 # ... and on publicationyear.
2770 ($tag,$subfield) = MARCfind_marc_from_kohafield($dbh,"biblioitems.publicationyear","");
2771 if ($record->field($tag)) {
2772 if ($record->field($tag)->subfields($subfield)) {
2773 push @tags, "'".$tag.$subfield."'";
2774 push @and_or, "and";
2775 push @excluding, "";
2776 push @operator, "=";
2777 push @value, $record->field($tag)->subfield($subfield);
2778 # warn "for publicationyear, I add $tag / $subfield".$record->field($tag)->subfield($subfield);
2782 ($tag,$subfield) = MARCfind_marc_from_kohafield($dbh,"biblioitems.size","");
2783 if ($record->field($tag)) {
2784 if ($record->field($tag)->subfields($subfield)) {
2785 push @tags, "'".$tag.$subfield."'";
2786 push @and_or, "and";
2787 push @excluding, "";
2788 push @operator, "=";
2789 push @value, $record->field($tag)->subfield($subfield);
2790 # warn "for size, I add $tag / $subfield".$record->field($tag)->subfield($subfield);
2793 # ... and on publisher.
2794 ($tag,$subfield) = MARCfind_marc_from_kohafield($dbh,"biblioitems.publishercode","");
2795 if ($record->field($tag)) {
2796 if ($record->field($tag)->subfields($subfield)) {
2797 push @tags, "'".$tag.$subfield."'";
2798 push @and_or, "and";
2799 push @excluding, "";
2800 push @operator, "=";
2801 push @value, $record->field($tag)->subfield($subfield);
2802 # warn "for publishercode, I add $tag / $subfield".$record->field($tag)->subfield($subfield);
2805 # ... and on volume.
2806 ($tag,$subfield) = MARCfind_marc_from_kohafield($dbh,"biblioitems.volume","");
2807 if ($record->field($tag)) {
2808 if ($record->field($tag)->subfields($subfield)) {
2809 push @tags, "'".$tag.$subfield."'";
2810 push @and_or, "and";
2811 push @excluding, "";
2812 push @operator, "=";
2813 push @value, $record->field($tag)->subfield($subfield);
2814 # warn "for volume, I add $tag / $subfield".$record->field($tag)->subfield($subfield);
2818 my ($finalresult,$nbresult) = C4::SearchMarc::catalogsearch($dbh,\@tags,\@and_or,\@excluding,\@operator,\@value,0,10);
2819 # there is at least 1 result => return the 1st one
2821 # warn "$nbresult => ".@$finalresult[0]->{biblionumber},@$finalresult[0]->{bibid},@$finalresult[0]->{title};
2822 return @$finalresult[0]->{biblionumber},@$finalresult[0]->{bibid},@$finalresult[0]->{title};
2824 # no result, returns nothing
2831 if(substr($isbn, 0, 1) <=7) {
2832 $seg1 = substr($isbn, 0, 1);
2833 } elsif(substr($isbn, 0, 2) <= 94) {
2834 $seg1 = substr($isbn, 0, 2);
2835 } elsif(substr($isbn, 0, 3) <= 995) {
2836 $seg1 = substr($isbn, 0, 3);
2837 } elsif(substr($isbn, 0, 4) <= 9989) {
2838 $seg1 = substr($isbn, 0, 4);
2840 $seg1 = substr($isbn, 0, 5);
2842 my $x = substr($isbn, length($seg1));
2844 if(substr($x, 0, 2) <= 19) {
2845 # if(sTmp2 < 10) sTmp2 = "0" sTmp2;
2846 $seg2 = substr($x, 0, 2);
2847 } elsif(substr($x, 0, 3) <= 699) {
2848 $seg2 = substr($x, 0, 3);
2849 } elsif(substr($x, 0, 4) <= 8399) {
2850 $seg2 = substr($x, 0, 4);
2851 } elsif(substr($x, 0, 5) <= 89999) {
2852 $seg2 = substr($x, 0, 5);
2853 } elsif(substr($x, 0, 6) <= 9499999) {
2854 $seg2 = substr($x, 0, 6);
2856 $seg2 = substr($x, 0, 7);
2858 my $seg3=substr($x,length($seg2));
2859 $seg3=substr($seg3,0,length($seg3)-1) ;
2860 my $seg4 = substr($x, -1, 1);
2861 return "$seg1-$seg2-$seg3-$seg4";
2865 END { } # module clean-up code here (global destructor)
2871 Koha Developement team <info@koha.org>
2873 Paul POULAIN paul.poulain@free.fr
2879 # Revision 1.131 2005/09/22 10:01:45 tipaul
2880 # see mail on koha-devel : code cleaning on Search.pm + normalizing API + use of biblionumber everywhere (instead of bn, biblio, ...)
2882 # Revision 1.130 2005/09/02 14:34:14 tipaul
2883 # continuing the work to move to zebra. Begin of work for MARC=OFF support.
2884 # IMPORTANT NOTE : the MARCkoha2marc sub API has been modified. Instead of biblionumber & biblioitemnumber, it now gets a hash.
2885 # The sub is used only in Biblio.pm, so the API change should be harmless (except for me, but i'm aware ;-) )
2887 # Revision 1.129 2005/08/12 13:50:31 tipaul
2888 # removing useless sub declarations
2890 # Revision 1.128 2005/08/11 16:12:47 tipaul
2891 # Playing with the zebra...
2893 # * go to koha cvs home directory
2894 # * in misc/zebra there is a unimarc directory. I suggest that marc21 libraries create a marc21 directory
2895 # * put your zebra.cfg files here & create your database.
2896 # * from koha cvs home directory, ln -s misc/zebra/marc21 zebra (I mean create a symbolic link to YOUR zebra directory)
2897 # * now, everytime you add/modify a biblio/item your zebra DB is updated correctly.
2900 # * this uses a system call in perl. CPU consumming, but we are waiting for indexdata Perl/zoom
2901 # * deletion still not work
2902 # * UNIMARC zebra config files are provided in misc/zebra/unimarc directory. The most important line being :
2904 # recordId: (bib1,Local-number)
2908 # elm 090 Local-number -
2909 # elm 090/? Local-number -
2910 # elm 090/?/9 Local-number !:w
2912 # (090$9 being the field mapped to biblio.biblionumber in Koha)
2914 # Revision 1.127 2005/08/11 14:37:32 tipaul
2916 # * removing useless subs
2917 # * removing some subs that are also elsewhere
2918 # * 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)
2920 # Revision 1.126 2005/08/11 09:13:28 tipaul
2921 # just removing useless subs (a lot !!!) for code cleaning
2923 # Revision 1.125 2005/08/11 09:00:07 tipaul
2924 # Ok guys, this time, it seems that item add and modif begin working as expected...
2925 # Still a lot of bugs to fix, of course
2927 # Revision 1.124 2005/08/10 10:21:15 tipaul
2928 # continuing the road to zebra :
2929 # - the biblio add begins to work.
2930 # - the biblio modif begins to work.
2932 # (still without doing anything on zebra)
2933 # (no new change in updatedatabase)
2935 # Revision 1.123 2005/08/09 14:10:28 tipaul
2936 # 1st commit to go to zebra.
2937 # don't update your cvs if you want to have a working head...
2939 # this commit contains :
2940 # * 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...
2941 # * 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.
2942 # * other files : get rid of bibid and use biblionumber instead.
2945 # * does not do anything on zebra yet.
2946 # * if you rename marc_subfield_table, you can't search anymore.
2947 # * you can view a biblio & bibliodetails, go to MARC editor, but NOT save any modif.
2948 # * 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 ;-) )
2950 # 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
2951 # 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.
2953 # tipaul cutted previous commit notes