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
78 C4::Biblio - acquisition, catalog management functions
82 ( lot of changes for Koha 3.0)
84 Koha 1.2 and previous version used a specific API to manage biblios. This API uses old-DB style parameters.
85 They are based on a hash, and store data in biblio/biblioitems/items tables (plus additionalauthors, bibliosubject and bibliosubtitle where applicable)
87 In Koha 2.0, we introduced a MARC-DB.
89 In Koha 3.0 we removed this MARC-DB for search as we wanted to use Zebra as search system.
91 So in Koha 3.0, saving a record means :
92 - storing the raw marc record (iso2709) in biblioitems.marc field. It contains both biblio & items informations.
93 - storing the "decoded information" in biblio/biblioitems/items as previously.
94 - using zebra to manage search & indexing on the MARC datas.
96 In Koha, there is a systempreference saying "MARC=ON" or "MARC=OFF"
98 * MARC=ON : when MARC=ON, koha uses a MARC::Record object (in sub parameters). Saving informations in the DB means :
99 - transform the MARC record into a hash
100 - add the raw marc record into the hash
101 - store them & update zebra
103 * MARC=OFF : when MARC=OFF, koha uses a hash object (in sub parameters). Saving informations in the DB means :
104 - transform the hash into a MARC record
105 - add the raw marc record into the hash
106 - store them and update zebra
109 That's why we need 3 types of subs :
113 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
115 =head2 NEWxxx related subs
119 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.
121 all subs requires/use $dbh as 1st parameter and a MARC::Record object as 2nd parameter. they sometimes requires another parameter.
125 =head2 something_elsexxx related subs
129 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.
131 all subs requires/use $dbh as 1st parameter and a hash as 2nd parameter.
140 my ($biblionumber,$record) = @_;
141 # create the iso2709 file for zebra
142 my $cgidir = C4::Context->intranetdir ."/cgi-bin";
143 unless (opendir(DIR, "$cgidir")) {
144 $cgidir = C4::Context->intranetdir."/";
147 my $filename = $cgidir."/zebra/biblios/BIBLIO".$biblionumber."iso2709";
148 open F,"> $filename";
149 print F $record->as_usmarc();
151 my $res = system("cd $cgidir/zebra;/usr/local/bin/zebraidx update biblios");
155 =head2 @tagslib = &MARCgettagslib($dbh,1|0,$frameworkcode);
159 2nd param is 1 for liblibrarian and 0 for libopac
160 $frameworkcode contains the framework reference. If empty or does not exist, the default one is used
162 returns a hash with all values for all fields and subfields for a given MARC framework :
163 $res->{$tag}->{lib} = ($forlibrarian or !$libopac)?$liblibrarian:$libopac;
165 ->{mandatory} = $mandatory;
166 ->{repeatable} = $repeatable;
167 ->{$subfield}->{lib} = ($forlibrarian or !$libopac)?$liblibrarian:$libopac;
169 ->{mandatory} = $mandatory;
170 ->{repeatable} = $repeatable;
171 ->{authorised_value} = $authorised_value;
172 ->{authtypecode} = $authtypecode;
173 ->{value_builder} = $value_builder;
174 ->{kohafield} = $kohafield;
175 ->{seealso} = $seealso;
176 ->{hidden} = $hidden;
185 my ( $dbh, $forlibrarian, $frameworkcode ) = @_;
186 $frameworkcode = "" unless $frameworkcode;
188 my $libfield = ( $forlibrarian eq 1 ) ? 'liblibrarian' : 'libopac';
190 # check that framework exists
193 "select count(*) from marc_tag_structure where frameworkcode=?");
194 $sth->execute($frameworkcode);
195 my ($total) = $sth->fetchrow;
196 $frameworkcode = "" unless ( $total > 0 );
199 "select tagfield,liblibrarian,libopac,mandatory,repeatable from marc_tag_structure where frameworkcode=? order by tagfield"
201 $sth->execute($frameworkcode);
202 my ( $liblibrarian, $libopac, $tag, $res, $tab, $mandatory, $repeatable );
204 while ( ( $tag, $liblibrarian, $libopac, $mandatory, $repeatable ) = $sth->fetchrow ) {
205 $res->{$tag}->{lib} = ($forlibrarian or !$libopac)?$liblibrarian:$libopac;
206 $res->{$tag}->{tab} = ""; # XXX
207 $res->{$tag}->{mandatory} = $mandatory;
208 $res->{$tag}->{repeatable} = $repeatable;
213 "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"
215 $sth->execute($frameworkcode);
218 my $authorised_value;
228 ( $tag, $subfield, $liblibrarian, , $libopac, $tab,
229 $mandatory, $repeatable, $authorised_value, $authtypecode,
230 $value_builder, $kohafield, $seealso, $hidden,
235 $res->{$tag}->{$subfield}->{lib} = ($forlibrarian or !$libopac)?$liblibrarian:$libopac;
236 $res->{$tag}->{$subfield}->{tab} = $tab;
237 $res->{$tag}->{$subfield}->{mandatory} = $mandatory;
238 $res->{$tag}->{$subfield}->{repeatable} = $repeatable;
239 $res->{$tag}->{$subfield}->{authorised_value} = $authorised_value;
240 $res->{$tag}->{$subfield}->{authtypecode} = $authtypecode;
241 $res->{$tag}->{$subfield}->{value_builder} = $value_builder;
242 $res->{$tag}->{$subfield}->{kohafield} = $kohafield;
243 $res->{$tag}->{$subfield}->{seealso} = $seealso;
244 $res->{$tag}->{$subfield}->{hidden} = $hidden;
245 $res->{$tag}->{$subfield}->{isurl} = $isurl;
246 $res->{$tag}->{$subfield}->{link} = $link;
251 =head2 ($tagfield,$tagsubfield) = &MARCfind_marc_from_kohafield($dbh,$kohafield);
255 finds MARC tag and subfield for a given kohafield
256 kohafield is "table.field" where table= biblio|biblioitems|items, and field a field of the previous table
262 sub MARCfind_marc_from_kohafield {
263 my ( $dbh, $kohafield,$frameworkcode ) = @_;
264 return 0, 0 unless $kohafield;
265 my $relations = C4::Context->marcfromkohafield;
266 return ($relations->{$frameworkcode}->{$kohafield}->[0],$relations->{$frameworkcode}->{$kohafield}->[1]);
269 =head2 $MARCRecord = &MARCgetbiblio($dbh,$biblionumber);
273 Returns a MARC::Record for the biblio $biblionumber.
279 # Returns MARC::Record of the biblio passed in parameter.
280 my ( $dbh, $biblionumber ) = @_;
281 my $sth = $dbh->prepare('select marcxml from biblioitems where biblionumber=?');
282 $sth->execute($biblionumber);
283 my ($marc) = $sth->fetchrow;
284 my $record = MARC::Record::new_from_xml($marc);
288 =head2 $XML = &XMLgetbiblio($dbh,$biblionumber);
292 Returns a raw XML for the biblio $biblionumber.
298 # Returns MARC::Record of the biblio passed in parameter.
299 my ( $dbh, $biblionumber ) = @_;
300 my $sth = $dbh->prepare('select marcxml,marc from biblioitems where biblionumber=?');
301 $sth->execute($biblionumber);
302 my ($XML,$marc) = $sth->fetchrow;
303 # my $record =MARC::Record::new_from_usmarc($marc);
304 # warn "MARC : \n*-************************\n".$record->as_xml."\n*-************************\n";
308 =head2 $MARCrecord = &MARCgetitem($dbh,$biblionumber);
312 Returns a MARC::Record with all items of biblio # $biblionumber
320 my ( $dbh, $biblionumber, $itemnumber ) = @_;
321 my $frameworkcode=MARCfind_frameworkcode($dbh,$biblionumber);
322 # get the complete MARC record
323 my $sth = $dbh->prepare("select marc from biblioitems where biblionumber=?");
324 $sth->execute($biblionumber);
325 my ($rawmarc) = $sth->fetchrow;
326 my $record = MARC::File::USMARC::decode($rawmarc);
327 # now, find the relevant itemnumber
328 my ($itemnumberfield,$itemnumbersubfield) = MARCfind_marc_from_kohafield($dbh,'items.itemnumber',$frameworkcode);
329 # prepare the new item record
330 my $itemrecord = MARC::Record->new();
331 # parse all fields fields from the complete record
332 foreach ($record->field($itemnumberfield)) {
333 # when the item field is found, save it
334 if ($_->subfield($itemnumbersubfield) == $itemnumber) {
335 $itemrecord->append_fields($_);
342 =head2 sub find_biblioitemnumber($dbh,$biblionumber);
346 Returns the 1st biblioitemnumber related to $biblionumber. When MARC=ON we should have 1 biblionumber = 1 and only 1 biblioitemnumber
347 This sub is useless when MARC=OFF
352 sub find_biblioitemnumber {
353 my ( $dbh, $biblionumber ) = @_;
354 my $sth = $dbh->prepare("select biblioitemnumber from biblioitems where biblionumber=?");
355 $sth->execute($biblionumber);
356 my ($biblioitemnumber) = $sth->fetchrow;
357 return $biblioitemnumber;
360 =head2 $frameworkcode = MARCfind_frameworkcode($dbh,$biblionumber);
364 returns the framework of a given biblio
370 sub MARCfind_frameworkcode {
371 my ( $dbh, $biblionumber ) = @_;
372 my $sth = $dbh->prepare("select frameworkcode from biblio where biblionumber=?");
373 $sth->execute($biblionumber);
374 my ($frameworkcode) = $sth->fetchrow;
375 return $frameworkcode;
378 =head2 $MARCRecord = &MARCkoha2marcBiblio($dbh,$bibliohash);
382 MARCkoha2marcBiblio is a wrapper between old-DB and MARC-DB. It returns a MARC::Record builded with old-DB biblio/biblioitem :
383 all entries of the hash are transformed into their matching MARC field/subfield.
389 sub MARCkoha2marcBiblio {
391 # this function builds partial MARC::Record from the old koha-DB fields
392 my ( $dbh, $bibliohash ) = @_;
393 # we don't have biblio entries in the hash, so we add them first
394 my $sth = $dbh->prepare("select * from biblio where biblionumber=?");
395 $sth->execute($bibliohash->{biblionumber});
396 my $biblio = $sth->fetchrow_hashref;
397 foreach (keys %$biblio) {
398 $bibliohash->{$_}=$biblio->{$_};
400 $sth = $dbh->prepare("select tagfield,tagsubfield from marc_subfield_structure where frameworkcode=? and kohafield=?");
401 my $record = MARC::Record->new();
402 foreach ( keys %$bibliohash ) {
403 &MARCkoha2marcOnefield( $sth, $record, "biblio." . $_, $bibliohash->{$_}, '') if $bibliohash->{$_};
404 &MARCkoha2marcOnefield( $sth, $record, "biblioitems." . $_, $bibliohash->{$_}, '') if $bibliohash->{$_};
407 # other fields => additional authors, subjects, subtitles
408 my $sth2 = $dbh->prepare(" SELECT author FROM additionalauthors WHERE biblionumber=?");
409 $sth2->execute($bibliohash->{biblionumber});
410 while ( my $row = $sth2->fetchrow_hashref ) {
411 &MARCkoha2marcOnefield( $sth, $record, "additionalauthors.author", $bibliohash->{'author'},'' );
413 $sth2 = $dbh->prepare(" SELECT subject FROM bibliosubject WHERE biblionumber=?");
414 $sth2->execute($bibliohash->{biblionumber});
415 while ( my $row = $sth2->fetchrow_hashref ) {
416 &MARCkoha2marcOnefield( $sth, $record, "bibliosubject.subject", $row->{'subject'},'' );
418 $sth2 = $dbh->prepare(" SELECT subtitle FROM bibliosubtitle WHERE biblionumber=?");
419 $sth2->execute($bibliohash->{biblionumber});
420 while ( my $row = $sth2->fetchrow_hashref ) {
421 &MARCkoha2marcOnefield( $sth, $record, "bibliosubtitle.subtitle", $row->{'subtitle'},'' );
427 =head2 $MARCRecord = &MARCkoha2marcItem($dbh,$biblionumber,itemnumber);
429 MARCkoha2marcItem is a wrapper between old-DB and MARC-DB. It returns a MARC::Record builded with old-DB items :
430 all entries of the hash are transformed into their matching MARC field/subfield.
438 sub MARCkoha2marcItem {
440 # this function builds partial MARC::Record from the old koha-DB fields
441 my ( $dbh, $item ) = @_;
443 # my $dbh=&C4Connect;
444 my $sth = $dbh->prepare("select tagfield,tagsubfield from marc_subfield_structure where frameworkcode=? and kohafield=?");
445 my $record = MARC::Record->new();
447 foreach( keys %$item ) {
449 &MARCkoha2marcOnefield( $sth, $record, "items." . $_,
456 =head2 MARCkoha2marcOnefield
460 This sub is for internal use only, used by koha2marcBiblio & koha2marcItem
466 sub MARCkoha2marcOnefield {
467 my ( $sth, $record, $kohafieldname, $value,$frameworkcode ) = @_;
470 $sth->execute($frameworkcode,$kohafieldname);
471 if ( ( $tagfield, $tagsubfield ) = $sth->fetchrow ) {
472 if ( $record->field($tagfield) ) {
473 my $tag = $record->field($tagfield);
475 $tag->add_subfields( $tagsubfield, $value );
476 $record->delete_field($tag);
477 $record->add_fields($tag);
481 $record->add_fields( $tagfield, " ", " ", $tagsubfield => $value );
487 =head2 $MARCrecord = MARChtml2marc($dbh,$rtags,$rsubfields,$rvalues,%indicators);
491 transforms the parameters (coming from HTML form) into a MARC::Record
492 parameters with r are references to arrays.
494 FIXME : should be improved for 3.0, to avoid having 4 differents arrays
501 my ($dbh,$rtags,$rsubfields,$rvalues,%indicators) = @_;
503 my $record = MARC::Record->new();
504 # my %subfieldlist=();
505 my $prevvalue; # if tag <10
506 my $field; # if tag >=10
507 for (my $i=0; $i< @$rtags; $i++) {
508 next unless @$rvalues[$i];
509 # rebuild MARC::Record
510 # warn "0=>".@$rtags[$i].@$rsubfields[$i]." = ".@$rvalues[$i].": ";
511 if (@$rtags[$i] ne $prevtag) {
514 if ($prevtag ne '000') {
515 $record->add_fields((sprintf "%03s",$prevtag),$prevvalue);
517 $record->leader($prevvalue);
522 $record->add_fields($field);
525 $indicators{@$rtags[$i]}.=' ';
526 if (@$rtags[$i] <10) {
527 $prevvalue= @$rvalues[$i];
531 $field = MARC::Field->new( (sprintf "%03s",@$rtags[$i]), substr($indicators{@$rtags[$i]},0,1),substr($indicators{@$rtags[$i]},1,1), @$rsubfields[$i] => @$rvalues[$i]);
532 # warn "1=>".@$rtags[$i].@$rsubfields[$i]." = ".@$rvalues[$i].": ".$field->as_formatted;
534 $prevtag = @$rtags[$i];
536 if (@$rtags[$i] <10) {
537 $prevvalue=@$rvalues[$i];
539 if (length(@$rvalues[$i])>0) {
540 $field->add_subfields(@$rsubfields[$i] => @$rvalues[$i]);
541 # warn "2=>".@$rtags[$i].@$rsubfields[$i]." = ".@$rvalues[$i].": ".$field->as_formatted;
544 $prevtag= @$rtags[$i];
547 # the last has not been included inside the loop... do it now !
548 $record->add_fields($field) if $field;
549 # warn "HTML2MARC=".$record->as_formatted;
554 =head2 $hash = &MARCmarc2koha($dbh,$MARCRecord);
558 builds a hash with old-db datas from a MARC::Record
565 my ($dbh,$record,$frameworkcode) = @_;
566 my $sth=$dbh->prepare("select tagfield,tagsubfield from marc_subfield_structure where frameworkcode=? and kohafield=?");
568 my $sth2=$dbh->prepare("SHOW COLUMNS from biblio");
571 while (($field)=$sth2->fetchrow) {
572 # warn "biblio.".$field;
573 $result=&MARCmarc2kohaOneField($sth,"biblio",$field,$record,$result,$frameworkcode);
575 $sth2=$dbh->prepare("SHOW COLUMNS from biblioitems");
577 while (($field)=$sth2->fetchrow) {
578 if ($field eq 'notes') { $field = 'bnotes'; }
579 # warn "biblioitems".$field;
580 $result=&MARCmarc2kohaOneField($sth,"biblioitems",$field,$record,$result,$frameworkcode);
582 $sth2=$dbh->prepare("SHOW COLUMNS from items");
584 while (($field)=$sth2->fetchrow) {
585 # warn "items".$field;
586 $result=&MARCmarc2kohaOneField($sth,"items",$field,$record,$result,$frameworkcode);
588 # additional authors : specific
589 $result = &MARCmarc2kohaOneField($sth,"bibliosubtitle","subtitle",$record,$result,$frameworkcode);
590 $result = &MARCmarc2kohaOneField($sth,"additionalauthors","additionalauthors",$record,$result,$frameworkcode);
591 # modify copyrightdate to keep only the 1st year found
592 my $temp = $result->{'copyrightdate'};
594 $temp =~ m/c(\d\d\d\d)/; # search cYYYY first
596 $result->{'copyrightdate'} = $1;
597 } else { # if no cYYYY, get the 1st date.
598 $temp =~ m/(\d\d\d\d)/;
599 $result->{'copyrightdate'} = $1;
602 # modify publicationyear to keep only the 1st year found
603 $temp = $result->{'publicationyear'};
604 $temp =~ m/c(\d\d\d\d)/; # search cYYYY first
606 $result->{'publicationyear'} = $1;
607 } else { # if no cYYYY, get the 1st date.
608 $temp =~ m/(\d\d\d\d)/;
609 $result->{'publicationyear'} = $1;
614 sub MARCmarc2kohaOneField {
616 # FIXME ? if a field has a repeatable subfield that is used in old-db, only the 1st will be retrieved...
617 my ( $sth, $kohatable, $kohafield, $record, $result,$frameworkcode ) = @_;
618 # warn "kohatable / $kohafield / $result / ";
622 ( $tagfield, $subfield ) = MARCfind_marc_from_kohafield("",$kohatable.".".$kohafield,$frameworkcode);
623 foreach my $field ( $record->field($tagfield) ) {
624 if ($field->tag()<10) {
625 if ($result->{$kohafield}) {
626 # Reverse array filled with elements from repeated subfields
627 # from first to last to avoid last to first concatenation of
628 # elements in Koha DB. -- thd.
629 $result->{$kohafield} .= " | ".reverse($field->data());
631 $result->{$kohafield} = $field->data();
634 if ( $field->subfields ) {
635 my @subfields = $field->subfields();
636 foreach my $subfieldcount ( 0 .. $#subfields ) {
637 if ($subfields[$subfieldcount][0] eq $subfield) {
638 if ( $result->{$kohafield} ) {
639 $result->{$kohafield} .= " | " . $subfields[$subfieldcount][1];
642 $result->{$kohafield} = $subfields[$subfieldcount][1];
649 # warn "OneField for $kohatable.$kohafield and $frameworkcode=> $tagfield, $subfield";
653 =head2 ($biblionumber,$biblioitemnumber) = NEWnewbibilio($dbh,$MARCRecord,$frameworkcode);
657 creates a biblio from a MARC::Record.
664 my ( $dbh, $record, $frameworkcode ) = @_;
666 my $biblioitemnumber;
667 my $olddata = MARCmarc2koha( $dbh, $record,$frameworkcode );
668 $olddata->{frameworkcode} = $frameworkcode;
669 $biblionumber = REALnewbiblio( $dbh, $olddata );
670 $olddata->{biblionumber} = $biblionumber;
671 # add biblionumber into the MARC record (it's the ID for zebra)
672 my ( $tagfield, $tagsubfield ) =
673 MARCfind_marc_from_kohafield( $dbh, "biblio.biblionumber",$frameworkcode );
677 $newfield = MARC::Field->new(
678 $tagfield, $biblionumber,
681 $newfield = MARC::Field->new(
682 $tagfield, '', '', "$tagsubfield" => $biblionumber,
685 # drop old field (just in case it already exist and create new one...
686 my $old_field = $record->field($tagfield);
687 $record->delete_field($old_field);
688 $record->add_fields($newfield);
690 #create the marc entry, that stores the rax marc record in Koha 3.0
691 $olddata->{marc} = $record->as_usmarc();
692 $olddata->{marcxml} = $record->as_xml();
693 # and create biblioitem, that's all folks !
694 $biblioitemnumber = REALnewbiblioitem( $dbh, $olddata );
696 # search subtiles, addiauthors and subjects
697 ( $tagfield, $tagsubfield ) =
698 MARCfind_marc_from_kohafield( $dbh, "additionalauthors.author",$frameworkcode );
699 my @addiauthfields = $record->field($tagfield);
700 foreach my $addiauthfield (@addiauthfields) {
701 my @addiauthsubfields = $addiauthfield->subfield($tagsubfield);
702 foreach my $subfieldcount ( 0 .. $#addiauthsubfields ) {
703 REALmodaddauthor( $dbh, $biblionumber,
704 $addiauthsubfields[$subfieldcount] );
707 ( $tagfield, $tagsubfield ) =
708 MARCfind_marc_from_kohafield( $dbh, "bibliosubtitle.subtitle",$frameworkcode );
709 my @subtitlefields = $record->field($tagfield);
710 foreach my $subtitlefield (@subtitlefields) {
711 my @subtitlesubfields = $subtitlefield->subfield($tagsubfield);
712 foreach my $subfieldcount ( 0 .. $#subtitlesubfields ) {
713 REALnewsubtitle( $dbh, $biblionumber,
714 $subtitlesubfields[$subfieldcount] );
717 ( $tagfield, $tagsubfield ) =
718 MARCfind_marc_from_kohafield( $dbh, "bibliosubject.subject",$frameworkcode );
719 my @subj = $record->field($tagfield);
721 foreach my $subject (@subj) {
722 my @subjsubfield = $subject->subfield($tagsubfield);
723 foreach my $subfieldcount ( 0 .. $#subjsubfield ) {
724 push @subjects, $subjsubfield[$subfieldcount];
727 REALmodsubject( $dbh, $biblionumber, 1, @subjects );
728 return ( $biblionumber, $biblioitemnumber );
731 =head2 NEWmodbilbioframework($dbh,$biblionumber,$frameworkcode);
735 modify the framework of a biblio
741 sub NEWmodbiblioframework {
742 my ($dbh,$biblionumber,$frameworkcode) =@_;
743 my $sth = $dbh->prepare("Update biblio SET frameworkcode=? WHERE biblionumber=?");
744 $sth->execute($frameworkcode,$biblionumber);
748 =head2 NEWmodbiblio($dbh,$MARCrecord,$biblionumber,$frameworkcode);
752 modify a biblio (MARC=ON)
759 my ($dbh,$record,$biblionumber,$frameworkcode) =@_;
760 $frameworkcode="" unless $frameworkcode;
761 # &MARCmodbiblio($dbh,$bibid,$record,$frameworkcode,0);
762 my $oldbiblio = MARCmarc2koha($dbh,$record,$frameworkcode);
764 $oldbiblio->{frameworkcode} = $frameworkcode;
765 #create the marc entry, that stores the rax marc record in Koha 3.0
766 $oldbiblio->{marc} = $record->as_usmarc();
767 $oldbiblio->{marcxml} = $record->as_xml();
769 REALmodbiblio($dbh,$oldbiblio);
770 REALmodbiblioitem($dbh,$oldbiblio);
771 # now, modify addi authors, subject, addititles.
772 my ($tagfield,$tagsubfield) = MARCfind_marc_from_kohafield($dbh,"additionalauthors.author",$frameworkcode);
773 my @addiauthfields = $record->field($tagfield);
774 foreach my $addiauthfield (@addiauthfields) {
775 my @addiauthsubfields = $addiauthfield->subfield($tagsubfield);
776 $dbh->do("delete from additionalauthors where biblionumber=$biblionumber");
777 foreach my $subfieldcount (0..$#addiauthsubfields) {
778 REALmodaddauthor($dbh,$biblionumber,$addiauthsubfields[$subfieldcount]);
781 ($tagfield,$tagsubfield) = MARCfind_marc_from_kohafield($dbh,"bibliosubtitle.subtitle",$frameworkcode);
782 my @subtitlefields = $record->field($tagfield);
783 foreach my $subtitlefield (@subtitlefields) {
784 my @subtitlesubfields = $subtitlefield->subfield($tagsubfield);
785 # delete & create subtitle again because REALmodsubtitle can't handle new subtitles
787 $dbh->do("delete from bibliosubtitle where biblionumber=$biblionumber");
788 foreach my $subfieldcount (0..$#subtitlesubfields) {
789 foreach my $subtit(split /\||#/,$subtitlesubfields[$subfieldcount]) {
790 REALnewsubtitle($dbh,$biblionumber,$subtit);
794 ($tagfield,$tagsubfield) = MARCfind_marc_from_kohafield($dbh,"bibliosubject.subject",$frameworkcode);
795 my @subj = $record->field($tagfield);
797 foreach my $subject (@subj) {
798 my @subjsubfield = $subject->subfield($tagsubfield);
799 foreach my $subfieldcount (0..$#subjsubfield) {
800 push @subjects,$subjsubfield[$subfieldcount];
803 REALmodsubject($dbh,$biblionumber,1,@subjects);
807 =head2 NEWmodbilbioframework($dbh,$biblionumber,$frameworkcode);
818 my ( $dbh, $bibid ) = @_;
819 my $biblio = &MARCfind_oldbiblionumber_from_MARCbibid( $dbh, $bibid );
820 &REALdelbiblio( $dbh, $biblio );
823 "select biblioitemnumber from biblioitems where biblionumber=?");
824 $sth->execute($biblio);
825 while ( my ($biblioitemnumber) = $sth->fetchrow ) {
826 REALdelbiblioitem( $dbh, $biblioitemnumber );
828 &MARCdelbiblio( $dbh, $bibid, 0 );
831 =head2 $itemnumber = NEWnewitem($dbh, $record, $biblionumber, $biblioitemnumber);
835 creates an item from a MARC::Record
842 my ( $dbh, $record, $biblionumber, $biblioitemnumber ) = @_;
845 my $frameworkcode=MARCfind_frameworkcode($dbh,$biblionumber);
846 my $item = &MARCmarc2koha( $dbh, $record,$frameworkcode );
847 # needs old biblionumber and biblioitemnumber
848 $item->{'biblionumber'} = $biblionumber;
849 $item->{'biblioitemnumber'}=$biblioitemnumber;
850 $item->{marc} = $record->as_usmarc();
851 my ( $itemnumber, $error ) = &REALnewitems( $dbh, $item, $item->{barcode} );
856 =head2 $itemnumber = NEWmoditem($dbh, $record, $biblionumber, $biblioitemnumber,$itemnumber);
867 my ( $dbh, $record, $biblionumber, $biblioitemnumber, $itemnumber) = @_;
869 my $frameworkcode=MARCfind_frameworkcode($dbh,$biblionumber);
870 my $olditem = MARCmarc2koha( $dbh, $record,$frameworkcode );
872 $olditem->{marc} = $record->as_usmarc();
873 $olditem->{biblionumber} = $biblionumber;
874 $olditem->{biblioitemnumber} = $biblioitemnumber;
876 REALmoditem( $dbh, $olditem );
880 =head2 $itemnumber = NEWdelitem($dbh, $biblionumber, $biblioitemnumber, $itemnumber);
891 my ( $dbh, $bibid, $itemnumber ) = @_;
892 my $biblio = &MARCfind_oldbiblionumber_from_MARCbibid( $dbh, $bibid );
893 &REALdelitem( $dbh, $itemnumber );
894 &MARCdelitem( $dbh, $bibid, $itemnumber );
898 =head2 $biblionumber = REALnewbiblio($dbh,$biblio);
902 adds a record in biblio table. Datas are in the hash $biblio.
909 my ( $dbh, $biblio ) = @_;
911 $dbh->do('lock tables biblio WRITE');
912 my $sth = $dbh->prepare("Select max(biblionumber) from biblio");
914 my $data = $sth->fetchrow_arrayref;
915 my $bibnum = $$data[0] + 1;
918 if ( $biblio->{'seriestitle'} ) { $series = 1 }
921 $dbh->prepare("insert into biblio set biblionumber=?, title=?, author=?, copyrightdate=?,
922 serial=?, seriestitle=?, notes=?, abstract=?,
926 $bibnum, $biblio->{'title'},
927 $biblio->{'author'}, $biblio->{'copyrightdate'},
928 $biblio->{'serial'}, $biblio->{'seriestitle'},
929 $biblio->{'notes'}, $biblio->{'abstract'},
930 $biblio->{'unititle'}
934 $dbh->do('unlock tables');
938 =head2 $biblionumber = REALmodbiblio($dbh,$biblio);
942 modify a record in biblio table. Datas are in the hash $biblio.
949 my ( $dbh, $biblio ) = @_;
950 my $sth = $dbh->prepare("Update biblio set title=?, author=?, abstract=?, copyrightdate=?,
951 seriestitle=?, serial=?, unititle=?, notes=?, frameworkcode=?
952 where biblionumber = ?"
955 $biblio->{'title'}, $biblio->{'author'},
956 $biblio->{'abstract'}, $biblio->{'copyrightdate'},
957 $biblio->{'seriestitle'}, $biblio->{'serial'},
958 $biblio->{'unititle'}, $biblio->{'notes'},
959 $biblio->{frameworkcode},
960 $biblio->{'biblionumber'}
963 return ( $biblio->{'biblionumber'} );
966 =head2 REALmodsubtitle($dbh,$bibnum,$subtitle);
970 modify subtitles in bibliosubtitle table.
976 sub REALmodsubtitle {
977 my ( $dbh, $bibnum, $subtitle ) = @_;
980 "update bibliosubtitle set subtitle = ? where biblionumber = ?");
981 $sth->execute( $subtitle, $bibnum );
985 =head2 REALmodaddauthor($dbh,$bibnum,$author);
989 adds or modify additional authors
990 NOTE : Strange sub : seems to delete MANY and add only ONE author... maybe buggy ?
996 sub REALmodaddauthor {
997 my ( $dbh, $bibnum, @authors ) = @_;
999 # my $dbh = C4Connect;
1001 $dbh->prepare("Delete from additionalauthors where biblionumber = ?");
1003 $sth->execute($bibnum);
1005 foreach my $author (@authors) {
1006 if ( $author ne '' ) {
1009 "Insert into additionalauthors set author = ?, biblionumber = ?"
1012 $sth->execute( $author, $bibnum );
1017 } # sub modaddauthor
1019 =head2 $errors = REALmodsubject($dbh,$bibnum, $force, @subject);
1023 modify/adds subjects
1028 sub REALmodsubject {
1029 my ( $dbh, $bibnum, $force, @subject ) = @_;
1031 # my $dbh = C4Connect;
1032 my $count = @subject;
1034 for ( my $i = 0 ; $i < $count ; $i++ ) {
1035 $subject[$i] =~ s/^ //g;
1036 $subject[$i] =~ s/ $//g;
1039 "select * from catalogueentry where entrytype = 's' and catalogueentry = ?"
1041 $sth->execute( $subject[$i] );
1043 if ( my $data = $sth->fetchrow_hashref ) {
1046 if ( $force eq $subject[$i] || $force == 1 ) {
1048 # subject not in aut, chosen to force anway
1049 # so insert into cataloguentry so its in auth file
1052 "Insert into catalogueentry (entrytype,catalogueentry) values ('s',?)"
1055 $sth2->execute( $subject[$i] ) if ( $subject[$i] );
1060 "$subject[$i]\n does not exist in the subject authority file";
1063 "Select * from catalogueentry where entrytype = 's' and (catalogueentry like ? or catalogueentry like ? or catalogueentry like ?)"
1065 $sth2->execute( "$subject[$i] %", "% $subject[$i] %",
1067 while ( my $data = $sth2->fetchrow_hashref ) {
1068 $error .= "<br>$data->{'catalogueentry'}";
1077 $dbh->prepare("Delete from bibliosubject where biblionumber = ?");
1078 $sth->execute($bibnum);
1082 "Insert into bibliosubject (subject,biblionumber) values (?,?)");
1084 foreach $query (@subject) {
1085 $sth->execute( $query, $bibnum ) if ( $query && $bibnum );
1094 =head2 REALmodbiblioitem($dbh, $biblioitem);
1103 sub REALmodbiblioitem {
1104 my ( $dbh, $biblioitem ) = @_;
1107 my $sth = $dbh->prepare("update biblioitems set number=?,volume=?, volumedate=?, lccn=?,
1108 itemtype=?, url=?, isbn=?, issn=?,
1109 publishercode=?, publicationyear=?, classification=?, dewey=?,
1110 subclass=?, illus=?, pages=?, volumeddesc=?,
1111 notes=?, size=?, place=?, marc=?,
1113 where biblioitemnumber=?");
1114 $sth->execute( $biblioitem->{number}, $biblioitem->{volume}, $biblioitem->{volumedate}, $biblioitem->{lccn},
1115 $biblioitem->{itemtype}, $biblioitem->{url}, $biblioitem->{isbn}, $biblioitem->{issn},
1116 $biblioitem->{publishercode}, $biblioitem->{publicationyear}, $biblioitem->{classification}, $biblioitem->{dewey},
1117 $biblioitem->{subclass}, $biblioitem->{illus}, $biblioitem->{pages}, $biblioitem->{volumeddesc},
1118 $biblioitem->{bnotes}, $biblioitem->{size}, $biblioitem->{place}, $biblioitem->{marc},
1119 $biblioitem->{marcxml}, $biblioitem->{biblioitemnumber});
1120 my $record = MARC::File::USMARC::decode($biblioitem->{marc});
1121 zebra_create($biblioitem->{biblionumber}, $record);
1122 # warn "MOD : $biblioitem->{biblioitemnumber} = ".$biblioitem->{marc};
1125 =head2 REALnewbiblioitem($dbh,$biblioitem);
1129 adds a biblioitem ($biblioitem is a hash with the values)
1135 sub REALnewbiblioitem {
1136 my ( $dbh, $biblioitem ) = @_;
1138 $dbh->do("lock tables biblioitems WRITE, biblio WRITE, marc_subfield_structure READ");
1139 my $sth = $dbh->prepare("Select max(biblioitemnumber) from biblioitems");
1141 my $biblioitemnumber;
1144 $data = $sth->fetchrow_arrayref;
1145 $biblioitemnumber = $$data[0] + 1;
1147 # Insert biblioitemnumber in MARC record, we need it to manage items later...
1148 my $frameworkcode=MARCfind_frameworkcode($dbh,$biblioitem->{biblionumber});
1149 my ($biblioitemnumberfield,$biblioitemnumbersubfield) = MARCfind_marc_from_kohafield($dbh,'biblioitems.biblioitemnumber',$frameworkcode);
1150 my $record = MARC::File::USMARC::decode($biblioitem->{marc});
1151 my $field=$record->field($biblioitemnumberfield);
1152 $field->update($biblioitemnumbersubfield => "$biblioitemnumber");
1153 $biblioitem->{marc} = $record->as_usmarc();
1154 $biblioitem->{marcxml} = $record->as_xml();
1156 $sth = $dbh->prepare( "insert into biblioitems set
1157 biblioitemnumber = ?, biblionumber = ?,
1158 volume = ?, number = ?,
1159 classification = ?, itemtype = ?,
1161 issn = ?, dewey = ?,
1162 subclass = ?, publicationyear = ?,
1163 publishercode = ?, volumedate = ?,
1164 volumeddesc = ?, illus = ?,
1165 pages = ?, notes = ?,
1167 marc = ?, place = ?,
1171 $biblioitemnumber, $biblioitem->{'biblionumber'},
1172 $biblioitem->{'volume'}, $biblioitem->{'number'},
1173 $biblioitem->{'classification'}, $biblioitem->{'itemtype'},
1174 $biblioitem->{'url'}, $biblioitem->{'isbn'},
1175 $biblioitem->{'issn'}, $biblioitem->{'dewey'},
1176 $biblioitem->{'subclass'}, $biblioitem->{'publicationyear'},
1177 $biblioitem->{'publishercode'}, $biblioitem->{'volumedate'},
1178 $biblioitem->{'volumeddesc'}, $biblioitem->{'illus'},
1179 $biblioitem->{'pages'}, $biblioitem->{'bnotes'},
1180 $biblioitem->{'size'}, $biblioitem->{'lccn'},
1181 $biblioitem->{'marc'}, $biblioitem->{'place'},
1182 $biblioitem->{marcxml},
1184 $dbh->do("unlock tables");
1185 zebra_create($biblioitem->{biblionumber}, $record);
1186 return ($biblioitemnumber);
1189 =head2 REALnewsubtitle($dbh,$bibnum,$subtitle);
1193 create a new subtitle
1198 sub REALnewsubtitle {
1199 my ( $dbh, $bibnum, $subtitle ) = @_;
1202 "insert into bibliosubtitle set biblionumber = ?, subtitle = ?");
1203 $sth->execute( $bibnum, $subtitle ) if $subtitle;
1207 =head2 ($itemnumber,$errors)= REALnewitems($dbh,$item,$barcode);
1211 create a item. $item is a hash and $barcode the barcode.
1218 my ( $dbh, $item, $barcode ) = @_;
1220 # warn "OLDNEWITEMS";
1222 $dbh->do('lock tables items WRITE, biblio WRITE,biblioitems WRITE,marc_subfield_structure WRITE');
1223 my $sth = $dbh->prepare("Select max(itemnumber) from items");
1228 $data = $sth->fetchrow_hashref;
1229 $itemnumber = $data->{'max(itemnumber)'} + 1;
1231 # FIXME the "notforloan" field seems to be named "loan" in some places. workaround bugfix.
1232 if ( $item->{'loan'} ) {
1233 $item->{'notforloan'} = $item->{'loan'};
1236 # if dateaccessioned is provided, use it. Otherwise, set to NOW()
1237 if ( $item->{'dateaccessioned'} ) {
1238 $sth = $dbh->prepare( "Insert into items set
1239 itemnumber = ?, biblionumber = ?,
1240 multivolumepart = ?,
1241 biblioitemnumber = ?, barcode = ?,
1242 booksellerid = ?, dateaccessioned = ?,
1243 homebranch = ?, holdingbranch = ?,
1244 price = ?, replacementprice = ?,
1245 replacementpricedate = NOW(), datelastseen = NOW(),
1246 multivolume = ?, stack = ?,
1247 itemlost = ?, wthdrawn = ?,
1248 paidfor = ?, itemnotes = ?,
1249 itemcallnumber =?, notforloan = ?,
1254 $itemnumber, $item->{'biblionumber'},
1255 $item->{'multivolumepart'},
1256 $item->{'biblioitemnumber'},$item->{barcode},
1257 $item->{'booksellerid'}, $item->{'dateaccessioned'},
1258 $item->{'homebranch'}, $item->{'holdingbranch'},
1259 $item->{'price'}, $item->{'replacementprice'},
1260 $item->{multivolume}, $item->{stack},
1261 $item->{itemlost}, $item->{wthdrawn},
1262 $item->{paidfor}, $item->{'itemnotes'},
1263 $item->{'itemcallnumber'}, $item->{'notforloan'},
1266 if ( defined $sth->errstr ) {
1267 $error .= $sth->errstr;
1271 $sth = $dbh->prepare( "Insert into items set
1272 itemnumber = ?, biblionumber = ?,
1273 multivolumepart = ?,
1274 biblioitemnumber = ?, barcode = ?,
1275 booksellerid = ?, dateaccessioned = NOW(),
1276 homebranch = ?, holdingbranch = ?,
1277 price = ?, replacementprice = ?,
1278 replacementpricedate = NOW(), datelastseen = NOW(),
1279 multivolume = ?, stack = ?,
1280 itemlost = ?, wthdrawn = ?,
1281 paidfor = ?, itemnotes = ?,
1282 itemcallnumber =?, notforloan = ?,
1287 $itemnumber, $item->{'biblionumber'},
1288 $item->{'multivolumepart'},
1289 $item->{'biblioitemnumber'},$item->{barcode},
1290 $item->{'booksellerid'},
1291 $item->{'homebranch'}, $item->{'holdingbranch'},
1292 $item->{'price'}, $item->{'replacementprice'},
1293 $item->{multivolume}, $item->{stack},
1294 $item->{itemlost}, $item->{wthdrawn},
1295 $item->{paidfor}, $item->{'itemnotes'},
1296 $item->{'itemcallnumber'}, $item->{'notforloan'},
1299 if ( defined $sth->errstr ) {
1300 $error .= $sth->errstr;
1303 # item stored, now, deal with the marc part...
1304 $sth = $dbh->prepare("select biblioitems.marc,biblio.frameworkcode from biblioitems,biblio
1305 where biblio.biblionumber=biblioitems.biblionumber and
1306 biblio.biblionumber=?");
1307 $sth->execute($item->{biblionumber});
1308 if ( defined $sth->errstr ) {
1309 $error .= $sth->errstr;
1311 my ($rawmarc,$frameworkcode) = $sth->fetchrow;
1312 warn "ERROR IN REALnewitem, MARC record not found FOR $item->{biblionumber} => $rawmarc <=" unless $rawmarc;
1313 my $record = MARC::File::USMARC::decode($rawmarc);
1314 # ok, we have the marc record, add item number to the item field (in {marc}, and add the field to the record)
1315 my ($itemnumberfield,$itemnumbersubfield) = MARCfind_marc_from_kohafield($dbh,'items.itemnumber',$frameworkcode);
1316 my $itemrecord = MARC::File::USMARC::decode($item->{marc});
1317 my $itemfield = $itemrecord->field($itemnumberfield);
1318 $itemfield->add_subfields($itemnumbersubfield => "$itemnumber");
1319 $record->insert_grouped_field($itemfield);
1320 # save the record into biblioitem
1321 $sth=$dbh->prepare("update biblioitems set marc=?,marcxml=? where biblionumber=?");
1322 $sth->execute($record->as_usmarc(),$record->as_xml(),$item->{biblionumber});
1323 if ( defined $sth->errstr ) {
1324 $error .= $sth->errstr;
1326 zebra_create($item->{biblionumber},$record);
1327 $dbh->do('unlock tables');
1328 return ( $itemnumber, $error );
1331 =head2 REALmoditem($dbh,$item);
1342 my ( $dbh, $item ) = @_;
1344 $dbh->do('lock tables items WRITE, biblio WRITE,biblioitems WRITE');
1345 $item->{'itemnum'} = $item->{'itemnumber'} unless $item->{'itemnum'};
1346 my $query = "update items set barcode=?,itemnotes=?,itemcallnumber=?,notforloan=?,location=?,multivolumepart=?,multivolume=?,stack=?,wthdrawn=?";
1348 $item->{'barcode'}, $item->{'itemnotes'},
1349 $item->{'itemcallnumber'}, $item->{'notforloan'},
1350 $item->{'location'}, $item->{multivolumepart},
1351 $item->{multivolume}, $item->{stack},
1354 if ( $item->{'lost'} ne '' ) {
1355 $query = "update items set biblioitemnumber=?,barcode=?,itemnotes=?,homebranch=?,
1356 itemlost=?,wthdrawn=?,itemcallnumber=?,notforloan=?,
1357 location=?,multivolumepart=?,multivolume=?,stack=?,wthdrawn=?";
1359 $item->{'bibitemnum'}, $item->{'barcode'},
1360 $item->{'itemnotes'}, $item->{'homebranch'},
1361 $item->{'lost'}, $item->{'wthdrawn'},
1362 $item->{'itemcallnumber'}, $item->{'notforloan'},
1363 $item->{'location'}, $item->{multivolumepart},
1364 $item->{multivolume}, $item->{stack},
1367 if ($item->{homebranch}) {
1368 $query.=",homebranch=?";
1369 push @bind, $item->{homebranch};
1371 if ($item->{holdingbranch}) {
1372 $query.=",holdingbranch=?";
1373 push @bind, $item->{holdingbranch};
1376 $query.=" where itemnumber=?";
1377 push @bind,$item->{'itemnum'};
1378 if ( $item->{'replacement'} ne '' ) {
1379 $query =~ s/ where/,replacementprice='$item->{'replacement'}' where/;
1381 my $sth = $dbh->prepare($query);
1382 $sth->execute(@bind);
1384 # item stored, now, deal with the marc part...
1385 $sth = $dbh->prepare("select biblioitems.marc,biblio.frameworkcode from biblioitems,biblio
1386 where biblio.biblionumber=biblioitems.biblionumber and
1387 biblio.biblionumber=? and
1388 biblioitems.biblioitemnumber=?");
1389 $sth->execute($item->{biblionumber},$item->{biblioitemnumber});
1390 if ( defined $sth->errstr ) {
1391 $error .= $sth->errstr;
1393 my ($rawmarc,$frameworkcode) = $sth->fetchrow;
1394 warn "ERROR IN REALmoditem, MARC record not found" unless $rawmarc;
1395 my $record = MARC::File::USMARC::decode($rawmarc);
1396 # ok, we have the marc record, find the previous item record for this itemnumber and delete it
1397 my ($itemnumberfield,$itemnumbersubfield) = MARCfind_marc_from_kohafield($dbh,'items.itemnumber',$frameworkcode);
1398 # prepare the new item record
1399 my $itemrecord = MARC::File::USMARC::decode($item->{marc});
1400 my $itemfield = $itemrecord->field($itemnumberfield);
1401 $itemfield->add_subfields($itemnumbersubfield => '$itemnumber');
1402 # parse all fields fields from the complete record
1403 foreach ($record->field($itemnumberfield)) {
1404 # when the previous field is found, replace by the new one
1405 if ($_->subfield($itemnumbersubfield) == $item->{itemnum}) {
1406 $_->replace_with($itemfield);
1409 # $record->insert_grouped_field($itemfield);
1410 # save the record into biblioitem
1411 $sth=$dbh->prepare("update biblioitems set marc=?,marcxml=? where biblionumber=? and biblioitemnumber=?");
1412 $sth->execute($record->as_usmarc(),$record->as_xml(),$item->{biblionumber},$item->{biblioitemnumber});
1413 zebra_create($item->biblionumber,$record);
1414 if ( defined $sth->errstr ) {
1415 $error .= $sth->errstr;
1417 $dbh->do('unlock tables');
1422 =head2 REALdelitem($dbh,$itemnum);
1433 my ( $dbh, $itemnum ) = @_;
1435 # my $dbh=C4Connect;
1436 my $sth = $dbh->prepare("select * from items where itemnumber=?");
1437 $sth->execute($itemnum);
1438 my $data = $sth->fetchrow_hashref;
1440 my $query = "Insert into deleteditems set ";
1442 foreach my $temp ( keys %$data ) {
1443 $query .= "$temp = ?,";
1444 push ( @bind, $data->{$temp} );
1449 $sth = $dbh->prepare($query);
1450 $sth->execute(@bind);
1452 $sth = $dbh->prepare("Delete from items where itemnumber=?");
1453 $sth->execute($itemnum);
1459 =head2 REALdelbiblioitem($dbh,$biblioitemnumber);
1463 deletes a biblioitem
1464 NOTE : not standard sub name. Should be REALdelbiblioitem()
1470 sub REALdelbiblioitem {
1471 my ( $dbh, $biblioitemnumber ) = @_;
1473 # my $dbh = C4Connect;
1474 my $sth = $dbh->prepare( "Select * from biblioitems
1475 where biblioitemnumber = ?"
1479 $sth->execute($biblioitemnumber);
1481 if ( $results = $sth->fetchrow_hashref ) {
1485 "Insert into deletedbiblioitems (biblioitemnumber, biblionumber, volume, number, classification, itemtype,
1486 isbn, issn ,dewey ,subclass ,publicationyear ,publishercode ,volumedate ,volumeddesc ,timestamp ,illus ,
1487 pages ,notes ,size ,url ,lccn ) values(?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)"
1491 $results->{biblioitemnumber}, $results->{biblionumber},
1492 $results->{volume}, $results->{number},
1493 $results->{classification}, $results->{itemtype},
1494 $results->{isbn}, $results->{issn},
1495 $results->{dewey}, $results->{subclass},
1496 $results->{publicationyear}, $results->{publishercode},
1497 $results->{volumedate}, $results->{volumeddesc},
1498 $results->{timestamp}, $results->{illus},
1499 $results->{pages}, $results->{notes},
1500 $results->{size}, $results->{url},
1504 $dbh->prepare("Delete from biblioitems where biblioitemnumber = ?");
1505 $sth2->execute($biblioitemnumber);
1510 # Now delete all the items attached to the biblioitem
1511 $sth = $dbh->prepare("Select * from items where biblioitemnumber = ?");
1512 $sth->execute($biblioitemnumber);
1514 while ( my $data = $sth->fetchrow_hashref ) {
1515 my $query = "Insert into deleteditems set ";
1517 foreach my $temp ( keys %$data ) {
1518 $query .= "$temp = ?,";
1519 push ( @bind, $data->{$temp} );
1522 my $sth2 = $dbh->prepare($query);
1523 $sth2->execute(@bind);
1526 $sth = $dbh->prepare("Delete from items where biblioitemnumber = ?");
1527 $sth->execute($biblioitemnumber);
1531 } # sub deletebiblioitem
1533 =head2 REALdelbiblio($dbh,$biblio);
1544 my ( $dbh, $biblio ) = @_;
1545 my $sth = $dbh->prepare("select * from biblio where biblionumber=?");
1546 $sth->execute($biblio);
1547 if ( my $data = $sth->fetchrow_hashref ) {
1549 my $query = "Insert into deletedbiblio set ";
1551 foreach my $temp ( keys %$data ) {
1552 $query .= "$temp = ?,";
1553 push ( @bind, $data->{$temp} );
1556 #replacing the last , by ",?)"
1558 $sth = $dbh->prepare($query);
1559 $sth->execute(@bind);
1561 $sth = $dbh->prepare("Delete from biblio where biblionumber=?");
1562 $sth->execute($biblio);
1568 =head2 $number = itemcount($biblio);
1572 returns the number of items attached to a biblio
1580 my $dbh = C4::Context->dbh;
1583 my $sth = $dbh->prepare("Select count(*) from items where biblionumber=?");
1584 $sth->execute($biblio);
1585 my $data = $sth->fetchrow_hashref;
1587 return ( $data->{'count(*)'} );
1590 =head2 $biblionumber = newbiblio($biblio);
1594 create a biblio. The parameter is a hash
1602 my $dbh = C4::Context->dbh;
1603 my $bibnum = REALnewbiblio( $dbh, $biblio );
1604 # finds new (MARC bibid
1605 # my $bibid = &MARCfind_MARCbibid_from_oldbiblionumber($dbh,$bibnum);
1606 # my $record = &MARCkoha2marcBiblio( $dbh, $bibnum );
1607 # MARCaddbiblio( $dbh, $record, $bibnum,'' );
1611 =head2 $biblionumber = &modbiblio($biblio);
1615 Update a biblio record.
1617 C<$biblio> is a reference-to-hash whose keys are the fields in the
1618 biblio table in the Koha database. All fields must be present, not
1619 just the ones you wish to change.
1621 C<&modbiblio> updates the record defined by
1622 C<$biblio-E<gt>{biblionumber}> with the values in C<$biblio>.
1624 C<&modbiblio> returns C<$biblio-E<gt>{biblionumber}> whether it was
1633 my $dbh = C4::Context->dbh;
1634 my $biblionumber=REALmodbiblio($dbh,$biblio);
1635 my $record = MARCkoha2marcBiblio($dbh,$biblionumber,$biblionumber);
1636 # finds new (MARC bibid
1637 my $bibid = &MARCfind_MARCbibid_from_oldbiblionumber($dbh,$biblionumber);
1638 MARCmodbiblio($dbh,$bibid,$record,"",0);
1639 return($biblionumber);
1642 =head2 &modsubtitle($biblionumber, $subtitle);
1646 Sets the subtitle of a book.
1648 C<$biblionumber> is the biblionumber of the book to modify.
1650 C<$subtitle> is the new subtitle.
1657 my ( $bibnum, $subtitle ) = @_;
1658 my $dbh = C4::Context->dbh;
1659 &REALmodsubtitle( $dbh, $bibnum, $subtitle );
1662 =head2 &modaddauthor($biblionumber, $author);
1666 Replaces all additional authors for the book with biblio number
1667 C<$biblionumber> with C<$author>. If C<$author> is the empty string,
1668 C<&modaddauthor> deletes all additional authors.
1675 my ( $bibnum, @authors ) = @_;
1676 my $dbh = C4::Context->dbh;
1677 &REALmodaddauthor( $dbh, $bibnum, @authors );
1678 } # sub modaddauthor
1680 =head2 $error = &modsubject($biblionumber, $force, @subjects);
1684 $force - a subject to force
1685 $error - Error message, or undef if successful.
1692 my ( $bibnum, $force, @subject ) = @_;
1693 my $dbh = C4::Context->dbh;
1694 my $error = &REALmodsubject( $dbh, $bibnum, $force, @subject );
1696 # When MARC is off, ensures that the MARC biblio table gets updated with new
1697 # subjects, of course, it deletes the biblio in marc, and then recreates.
1698 # This check is to ensure that no MARC data exists to lose.
1699 # if (C4::Context->preference("MARC") eq '0'){
1700 # warn "in modSUBJECT";
1701 # my $MARCRecord = &MARCkoha2marcBiblio($dbh,$bibnum);
1702 # my $bibid = &MARCfind_MARCbibid_from_oldbiblionumber($dbh,$bibnum);
1703 # &MARCmodbiblio($dbh,$bibid, $MARCRecord);
1709 =head2 modbibitem($biblioitem);
1713 modify a biblioitem. The parameter is a hash
1720 my ($biblioitem) = @_;
1721 my $dbh = C4::Context->dbh;
1722 &REALmodbiblioitem( $dbh, $biblioitem );
1725 =head2 $biblioitemnumber = newbiblioitem($biblioitem)
1729 create a biblioitem, the parameter is a hash
1736 my ($biblioitem) = @_;
1737 my $dbh = C4::Context->dbh;
1738 # add biblio information to the hash
1739 my $MARCbiblio = MARCkoha2marcBiblio( $dbh, $biblioitem );
1740 $biblioitem->{marc} = $MARCbiblio->as_usmarc();
1741 my $bibitemnum = &REALnewbiblioitem( $dbh, $biblioitem );
1742 return ($bibitemnum);
1745 =head2 newsubtitle($biblionumber,$subtitle);
1749 insert a subtitle for $biblionumber biblio
1757 my ( $bibnum, $subtitle ) = @_;
1758 my $dbh = C4::Context->dbh;
1759 &REALnewsubtitle( $dbh, $bibnum, $subtitle );
1762 =head2 $errors = newitems($item, @barcodes);
1766 insert items ($item is a hash)
1774 my ( $item, @barcodes ) = @_;
1775 my $dbh = C4::Context->dbh;
1779 foreach my $barcode (@barcodes) {
1780 # add items, one by one for each barcode.
1782 $oneitem->{barcode}= $barcode;
1783 my $MARCitem = &MARCkoha2marcItem( $dbh, $oneitem);
1784 $oneitem->{marc} = $MARCitem->as_usmarc;
1785 ( $itemnumber, $error ) = &REALnewitems( $dbh, $oneitem);
1786 # $errors .= $error;
1787 # &MARCadditem( $dbh, $MARCitem, $item->{biblionumber} );
1792 =head2 moditem($item);
1796 modify an item ($item is a hash with all item informations)
1805 my $dbh = C4::Context->dbh;
1806 &REALmoditem( $dbh, $item );
1808 &MARCkoha2marcItem( $dbh, $item->{'biblionumber'}, $item->{'itemnum'} );
1810 &MARCfind_MARCbibid_from_oldbiblionumber( $dbh, $item->{biblionumber} );
1811 &MARCmoditem( $dbh, $MARCitem, $bibid, $item->{itemnum}, 0 );
1814 =head2 $error = checkitems($count,@barcodes);
1818 check for each @barcode entry that the barcode is not a duplicate
1825 my ( $count, @barcodes ) = @_;
1826 my $dbh = C4::Context->dbh;
1828 my $sth = $dbh->prepare("Select * from items where barcode=?");
1829 for ( my $i = 0 ; $i < $count ; $i++ ) {
1830 $barcodes[$i] = uc $barcodes[$i];
1831 $sth->execute( $barcodes[$i] );
1832 if ( my $data = $sth->fetchrow_hashref ) {
1833 $error .= " Duplicate Barcode: $barcodes[$i]";
1840 =head2 $delitem($itemnum);
1844 delete item $itemnum being the item number to delete
1852 my $dbh = C4::Context->dbh;
1853 &REALdelitem( $dbh, $itemnum );
1856 =head2 deletebiblioitem($biblioitemnumber);
1860 delete the biblioitem $biblioitemnumber
1866 sub deletebiblioitem {
1867 my ($biblioitemnumber) = @_;
1868 my $dbh = C4::Context->dbh;
1869 &REALdelbiblioitem( $dbh, $biblioitemnumber );
1870 } # sub deletebiblioitem
1872 =head2 delbiblio($biblionumber)
1876 delete biblio $biblionumber
1884 my $dbh = C4::Context->dbh;
1885 &REALdelbiblio( $dbh, $biblio );
1886 my $bibid = &MARCfind_MARCbibid_from_oldbiblionumber( $dbh, $biblio );
1887 &MARCdelbiblio( $dbh, $bibid, 0 );
1890 =head2 ($count,@results) = getbiblio($biblionumber);
1894 return an array with hash of biblios.
1896 FIXME : biblionumber being the primary key, this sub will always return only 1 result, API should be modified...
1903 my ($biblionumber) = @_;
1904 my $dbh = C4::Context->dbh;
1905 my $sth = $dbh->prepare("Select * from biblio where biblionumber = ?");
1907 # || die "Cannot prepare $query\n" . $dbh->errstr;
1911 $sth->execute($biblionumber);
1913 # || die "Cannot execute $query\n" . $sth->errstr;
1914 while ( my $data = $sth->fetchrow_hashref ) {
1915 $results[$count] = $data;
1920 return ( $count, @results );
1925 $data = &bibdata($biblionumber, $type);
1927 Returns information about the book with the given biblionumber.
1929 C<$type> is ignored.
1931 C<&bibdata> returns a reference-to-hash. The keys are the fields in
1932 the C<biblio>, C<biblioitems>, and C<bibliosubtitle> tables in the
1935 In addition, C<$data-E<gt>{subject}> is the list of the book's
1936 subjects, separated by C<" , "> (space, comma, space).
1938 If there are multiple biblioitems with the given biblionumber, only
1939 the first one is considered.
1944 my ($bibnum, $type) = @_;
1945 my $dbh = C4::Context->dbh;
1946 my $sth = $dbh->prepare("Select *, biblioitems.notes AS bnotes, biblio.notes
1948 left join biblioitems on biblioitems.biblionumber = biblio.biblionumber
1949 left join bibliosubtitle on
1950 biblio.biblionumber = bibliosubtitle.biblionumber
1951 left join itemtypes on biblioitems.itemtype=itemtypes.itemtype
1952 where biblio.biblionumber = ?
1954 $sth->execute($bibnum);
1956 $data = $sth->fetchrow_hashref;
1958 # handle management of repeated subtitle
1959 $sth = $dbh->prepare("Select * from bibliosubtitle where biblionumber = ?");
1960 $sth->execute($bibnum);
1962 while (my $dat = $sth->fetchrow_hashref){
1964 $line{subtitle} = $dat->{subtitle};
1965 push @subtitles, \%line;
1967 $data->{subtitles} = \@subtitles;
1969 $sth = $dbh->prepare("Select * from bibliosubject where biblionumber = ?");
1970 $sth->execute($bibnum);
1972 while (my $dat = $sth->fetchrow_hashref){
1974 $line{subject} = $dat->{'subject'};
1975 push @subjects, \%line;
1977 $data->{subjects} = \@subjects;
1979 $sth = $dbh->prepare("Select * from additionalauthors where biblionumber = ?");
1980 $sth->execute($bibnum);
1981 while (my $dat = $sth->fetchrow_hashref){
1982 $data->{'additionalauthors'} .= "$dat->{'author'} - ";
1984 chop $data->{'additionalauthors'};
1985 chop $data->{'additionalauthors'};
1986 chop $data->{'additionalauthors'};
1991 =head2 ($count,@results) = getbiblioitem($biblioitemnumber);
1995 return an array with hash of biblioitemss.
1997 FIXME : biblioitemnumber being unique, this sub will always return only 1 result, API should be modified...
2004 my ($biblioitemnum) = @_;
2005 my $dbh = C4::Context->dbh;
2006 my $sth = $dbh->prepare( "Select * from biblioitems where
2007 biblioitemnumber = ?"
2012 $sth->execute($biblioitemnum);
2014 while ( my $data = $sth->fetchrow_hashref ) {
2015 $results[$count] = $data;
2020 return ( $count, @results );
2021 } # sub getbiblioitem
2023 =head2 ($count,@results) = getbiblioitembybiblionumber($biblionumber);
2027 return an array with hash of biblioitems for the given biblionumber.
2033 sub getbiblioitembybiblionumber {
2034 my ($biblionumber) = @_;
2035 my $dbh = C4::Context->dbh;
2036 my $sth = $dbh->prepare("Select * from biblioitems where biblionumber = ?");
2040 $sth->execute($biblionumber);
2042 while ( my $data = $sth->fetchrow_hashref ) {
2043 $results[$count] = $data;
2048 return ( $count, @results );
2051 =head2 ($count,@results) = getitemsbybiblioitem($biblionumber);
2055 returns an array with hash of items
2061 sub getitemsbybiblioitem {
2062 my ($biblioitemnum) = @_;
2063 my $dbh = C4::Context->dbh;
2064 my $sth = $dbh->prepare( "Select * from items, biblio where
2065 biblio.biblionumber = items.biblionumber and biblioitemnumber
2069 # || die "Cannot prepare $query\n" . $dbh->errstr;
2073 $sth->execute($biblioitemnum);
2075 # || die "Cannot execute $query\n" . $sth->errstr;
2076 while ( my $data = $sth->fetchrow_hashref ) {
2077 $results[$count] = $data;
2082 return ( $count, @results );
2083 } # sub getitemsbybiblioitem
2087 @results = &ItemInfo($env, $biblionumber, $type);
2089 Returns information about books with the given biblionumber.
2091 C<$type> may be either C<intra> or anything else. If it is not set to
2092 C<intra>, then the search will exclude lost, very overdue, and
2097 C<&ItemInfo> returns a list of references-to-hash. Each element
2098 contains a number of keys. Most of them are table items from the
2099 C<biblio>, C<biblioitems>, C<items>, and C<itemtypes> tables in the
2100 Koha database. Other keys include:
2104 =item C<$data-E<gt>{branchname}>
2106 The name (not the code) of the branch to which the book belongs.
2108 =item C<$data-E<gt>{datelastseen}>
2110 This is simply C<items.datelastseen>, except that while the date is
2111 stored in YYYY-MM-DD format in the database, here it is converted to
2112 DD/MM/YYYY format. A NULL date is returned as C<//>.
2114 =item C<$data-E<gt>{datedue}>
2116 =item C<$data-E<gt>{class}>
2118 This is the concatenation of C<biblioitems.classification>, the book's
2119 Dewey code, and C<biblioitems.subclass>.
2121 =item C<$data-E<gt>{ocount}>
2123 I think this is the number of copies of the book available.
2125 =item C<$data-E<gt>{order}>
2127 If this is set, it is set to C<One Order>.
2134 my ($env,$biblionumber,$type) = @_;
2135 my $dbh = C4::Context->dbh;
2136 my $query = "SELECT *,items.notforloan as itemnotforloan FROM items, biblio, biblioitems
2137 left join itemtypes on biblioitems.itemtype = itemtypes.itemtype
2138 WHERE items.biblionumber = ?
2139 AND biblioitems.biblioitemnumber = items.biblioitemnumber
2140 AND biblio.biblionumber = items.biblionumber";
2141 $query .= " order by items.dateaccessioned desc";
2142 my $sth=$dbh->prepare($query);
2143 $sth->execute($biblionumber);
2146 while (my $data=$sth->fetchrow_hashref){
2148 my $isth=$dbh->prepare("Select issues.*,borrowers.cardnumber from issues,borrowers where itemnumber = ? and returndate is null and issues.borrowernumber=borrowers.borrowernumber");
2149 $isth->execute($data->{'itemnumber'});
2150 if (my $idata=$isth->fetchrow_hashref){
2151 $data->{borrowernumber} = $idata->{borrowernumber};
2152 $data->{cardnumber} = $idata->{cardnumber};
2153 $datedue = format_date($idata->{'date_due'});
2155 if ($datedue eq ''){
2156 my ($restype,$reserves)=C4::Reserves2::CheckReserves($data->{'itemnumber'});
2162 #get branch information.....
2163 my $bsth=$dbh->prepare("SELECT * FROM branches WHERE branchcode = ?");
2164 $bsth->execute($data->{'holdingbranch'});
2165 if (my $bdata=$bsth->fetchrow_hashref){
2166 $data->{'branchname'} = $bdata->{'branchname'};
2168 my $date=format_date($data->{'datelastseen'});
2169 $data->{'datelastseen'}=$date;
2170 $data->{'datedue'}=$datedue;
2171 # get notforloan complete status if applicable
2172 my $sthnflstatus = $dbh->prepare('select authorised_value from marc_subfield_structure where kohafield="items.notforloan"');
2173 $sthnflstatus->execute;
2174 my ($authorised_valuecode) = $sthnflstatus->fetchrow;
2175 if ($authorised_valuecode) {
2176 $sthnflstatus = $dbh->prepare("select lib from authorised_values where category=? and authorised_value=?");
2177 $sthnflstatus->execute($authorised_valuecode,$data->{itemnotforloan});
2178 my ($lib) = $sthnflstatus->fetchrow;
2179 $data->{notforloan} = $lib;
2190 ($count, @results) = &bibitems($biblionumber);
2192 Given the biblionumber for a book, C<&bibitems> looks up that book's
2193 biblioitems (different publications of the same book, the audio book
2194 and film versions, etc.).
2196 C<$count> is the number of elements in C<@results>.
2198 C<@results> is an array of references-to-hash; the keys are the fields
2199 of the C<biblioitems> and C<itemtypes> tables of the Koha database. In
2200 addition, C<itemlost> indicates the availability of the item: if it is
2201 "2", then all copies of the item are long overdue; if it is "1", then
2202 all copies are lost; otherwise, there is at least one copy available.
2208 my $dbh = C4::Context->dbh;
2209 my $sth = $dbh->prepare("SELECT biblioitems.*,
2211 MIN(items.itemlost) as itemlost,
2212 MIN(items.dateaccessioned) as dateaccessioned
2213 FROM biblioitems, itemtypes, items
2214 WHERE biblioitems.biblionumber = ?
2215 AND biblioitems.itemtype = itemtypes.itemtype
2216 AND biblioitems.biblioitemnumber = items.biblioitemnumber
2217 GROUP BY items.biblioitemnumber");
2220 $sth->execute($bibnum);
2221 while (my $data = $sth->fetchrow_hashref) {
2222 $results[$count] = $data;
2226 return($count, @results);
2232 $itemdata = &bibitemdata($biblioitemnumber);
2234 Looks up the biblioitem with the given biblioitemnumber. Returns a
2235 reference-to-hash. The keys are the fields from the C<biblio>,
2236 C<biblioitems>, and C<itemtypes> tables in the Koha database, except
2237 that C<biblioitems.notes> is given as C<$itemdata-E<gt>{bnotes}>.
2243 my $dbh = C4::Context->dbh;
2244 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");
2247 $sth->execute($bibitem);
2249 $data = $sth->fetchrow_hashref;
2256 =item getbibliofromitemnumber
2258 $item = &getbibliofromitemnumber($env, $dbh, $itemnumber);
2260 Looks up the item with the given itemnumber.
2262 C<$env> and C<$dbh> are ignored.
2264 C<&itemnodata> returns a reference-to-hash whose keys are the fields
2265 from the C<biblio>, C<biblioitems>, and C<items> tables in the Koha
2270 sub getbibliofromitemnumber {
2271 my ($env,$dbh,$itemnumber) = @_;
2272 $dbh = C4::Context->dbh;
2273 my $sth=$dbh->prepare("Select * from biblio,items,biblioitems
2274 where items.itemnumber = ?
2275 and biblio.biblionumber = items.biblionumber
2276 and biblioitems.biblioitemnumber = items.biblioitemnumber");
2278 $sth->execute($itemnumber);
2279 my $data=$sth->fetchrow_hashref;
2286 @barcodes = &barcodes($biblioitemnumber);
2288 Given a biblioitemnumber, looks up the corresponding items.
2290 Returns an array of references-to-hash; the keys are C<barcode> and
2293 The returned items include very overdue items, but not lost ones.
2298 #called from request.pl
2299 my ($biblioitemnumber)=@_;
2300 my $dbh = C4::Context->dbh;
2301 my $sth=$dbh->prepare("SELECT barcode, itemlost, holdingbranch FROM items
2302 WHERE biblioitemnumber = ?
2303 AND (wthdrawn <> 1 OR wthdrawn IS NULL)");
2304 $sth->execute($biblioitemnumber);
2307 while (my $data=$sth->fetchrow_hashref){
2308 $barcodes[$i]=$data;
2318 $item = &itemdata($barcode);
2320 Looks up the item with the given barcode, and returns a
2321 reference-to-hash containing information about that item. The keys of
2322 the hash are the fields from the C<items> and C<biblioitems> tables in
2327 sub get_item_from_barcode {
2329 my $dbh = C4::Context->dbh;
2330 my $sth=$dbh->prepare("Select * from items,biblioitems where barcode=?
2331 and items.biblioitemnumber=biblioitems.biblioitemnumber");
2332 $sth->execute($barcode);
2333 my $data=$sth->fetchrow_hashref;
2341 @issues = &itemissues($biblioitemnumber, $biblio);
2343 Looks up information about who has borrowed the bookZ<>(s) with the
2344 given biblioitemnumber.
2346 C<$biblio> is ignored.
2348 C<&itemissues> returns an array of references-to-hash. The keys
2349 include the fields from the C<items> table in the Koha database.
2350 Additional keys include:
2356 If the item is currently on loan, this gives the due date.
2358 If the item is not on loan, then this is either "Available" or
2359 "Cancelled", if the item has been withdrawn.
2363 If the item is currently on loan, this gives the card number of the
2364 patron who currently has the item.
2366 =item C<timestamp0>, C<timestamp1>, C<timestamp2>
2368 These give the timestamp for the last three times the item was
2371 =item C<card0>, C<card1>, C<card2>
2373 The card number of the last three patrons who borrowed this item.
2375 =item C<borrower0>, C<borrower1>, C<borrower2>
2377 The borrower number of the last three patrons who borrowed this item.
2384 my ($bibitem, $biblio)=@_;
2385 my $dbh = C4::Context->dbh;
2386 # FIXME - If this function die()s, the script will abort, and the
2387 # user won't get anything; depending on how far the script has
2388 # gotten, the user might get a blank page. It would be much better
2389 # to at least print an error message. The easiest way to do this
2390 # is to set $SIG{__DIE__}.
2391 my $sth = $dbh->prepare("Select * from items where
2392 items.biblioitemnumber = ?")
2393 || die $dbh->errstr;
2397 $sth->execute($bibitem)
2398 || die $sth->errstr;
2400 while (my $data = $sth->fetchrow_hashref) {
2401 # Find out who currently has this item.
2402 # FIXME - Wouldn't it be better to do this as a left join of
2403 # some sort? Currently, this code assumes that if
2404 # fetchrow_hashref() fails, then the book is on the shelf.
2405 # fetchrow_hashref() can fail for any number of reasons (e.g.,
2406 # database server crash), not just because no items match the
2408 my $sth2 = $dbh->prepare("select * from issues,borrowers
2409 where itemnumber = ?
2410 and returndate is NULL
2411 and issues.borrowernumber = borrowers.borrowernumber");
2413 $sth2->execute($data->{'itemnumber'});
2414 if (my $data2 = $sth2->fetchrow_hashref) {
2415 $data->{'date_due'} = $data2->{'date_due'};
2416 $data->{'card'} = $data2->{'cardnumber'};
2417 $data->{'borrower'} = $data2->{'borrowernumber'};
2419 if ($data->{'wthdrawn'} eq '1') {
2420 $data->{'date_due'} = 'Cancelled';
2422 $data->{'date_due'} = 'Available';
2428 # Find the last 3 people who borrowed this item.
2429 $sth2 = $dbh->prepare("select * from issues, borrowers
2430 where itemnumber = ?
2431 and issues.borrowernumber = borrowers.borrowernumber
2432 and returndate is not NULL
2433 order by returndate desc,timestamp desc") || die $dbh->errstr;
2434 $sth2->execute($data->{'itemnumber'}) || die $sth2->errstr;
2435 for (my $i2 = 0; $i2 < 2; $i2++) { # FIXME : error if there is less than 3 pple borrowing this item
2436 if (my $data2 = $sth2->fetchrow_hashref) {
2437 $data->{"timestamp$i2"} = $data2->{'timestamp'};
2438 $data->{"card$i2"} = $data2->{'cardnumber'};
2439 $data->{"borrower$i2"} = $data2->{'borrowernumber'};
2444 $results[$i] = $data;
2454 ($count, $subjects) = &getsubject($biblionumber);
2456 Looks up the subjects of the book with the given biblionumber. Returns
2457 a two-element list. C<$subjects> is a reference-to-array, where each
2458 element is a subject of the book, and C<$count> is the number of
2459 elements in C<$subjects>.
2465 my $dbh = C4::Context->dbh;
2466 my $sth=$dbh->prepare("Select * from bibliosubject where biblionumber=?");
2467 $sth->execute($bibnum);
2470 while (my $data=$sth->fetchrow_hashref){
2475 return($i,\@results);
2480 ($count, $authors) = &getaddauthor($biblionumber);
2482 Looks up the additional authors for the book with the given
2485 Returns a two-element list. C<$authors> is a reference-to-array, where
2486 each element is an additional author, and C<$count> is the number of
2487 elements in C<$authors>.
2493 my $dbh = C4::Context->dbh;
2494 my $sth=$dbh->prepare("Select * from additionalauthors where biblionumber=?");
2495 $sth->execute($bibnum);
2498 while (my $data=$sth->fetchrow_hashref){
2503 return($i,\@results);
2509 ($count, $subtitles) = &getsubtitle($biblionumber);
2511 Looks up the subtitles for the book with the given biblionumber.
2513 Returns a two-element list. C<$subtitles> is a reference-to-array,
2514 where each element is a subtitle, and C<$count> is the number of
2515 elements in C<$subtitles>.
2521 my $dbh = C4::Context->dbh;
2522 my $sth=$dbh->prepare("Select * from bibliosubtitle where biblionumber=?");
2523 $sth->execute($bibnum);
2526 while (my $data=$sth->fetchrow_hashref){
2531 return($i,\@results);
2537 ($count, @websites) = &getwebsites($biblionumber);
2539 Looks up the web sites pertaining to the book with the given
2542 C<$count> is the number of elements in C<@websites>.
2544 C<@websites> is an array of references-to-hash; the keys are the
2545 fields from the C<websites> table in the Koha database.
2548 #FIXME : could maybe be deleted. Otherwise, would be better in a Websites.pm package
2549 #(with add / modify / delete subs)
2552 my ($biblionumber) = @_;
2553 my $dbh = C4::Context->dbh;
2554 my $sth = $dbh->prepare("Select * from websites where biblionumber = ?");
2558 $sth->execute($biblionumber);
2559 while (my $data = $sth->fetchrow_hashref) {
2560 # FIXME - The URL scheme shouldn't be stripped off, at least
2561 # not here, since it's part of the URL, and will be useful in
2562 # constructing a link to the site. If you don't want the user
2563 # to see the "http://" part, strip that off when building the
2565 $data->{'url'} =~ s/^http:\/\///; # FIXME - Leaning toothpick
2567 $results[$count] = $data;
2572 return($count, @results);
2575 =item getwebbiblioitems
2577 ($count, @results) = &getwebbiblioitems($biblionumber);
2579 Given a book's biblionumber, looks up the web versions of the book
2580 (biblioitems with itemtype C<WEB>).
2582 C<$count> is the number of items in C<@results>. C<@results> is an
2583 array of references-to-hash; the keys are the items from the
2584 C<biblioitems> table of the Koha database.
2588 sub getwebbiblioitems {
2589 my ($biblionumber) = @_;
2590 my $dbh = C4::Context->dbh;
2591 my $sth = $dbh->prepare("Select * from biblioitems where biblionumber = ?
2592 and itemtype = 'WEB'");
2596 $sth->execute($biblionumber);
2597 while (my $data = $sth->fetchrow_hashref) {
2598 $data->{'url'} =~ s/^http:\/\///;
2599 $results[$count] = $data;
2604 return($count, @results);
2605 } # sub getwebbiblioitems
2609 # converts ISO 5426 coded string to ISO 8859-1
2610 # sloppy code : should be improved in next issue
2611 my ( $string, $encoding ) = @_;
2614 # $encoding = C4::Context->preference("marcflavour") unless $encoding;
2615 if ( $encoding eq "UNIMARC" ) {
2684 # this handles non-sorting blocks (if implementation requires this)
2685 $string = nsb_clean($_);
2687 elsif ( $encoding eq "USMARC" || $encoding eq "MARC21" ) {
2688 if (/[\xc1-\xff]/) {
2741 # this handles non-sorting blocks (if implementation requires this)
2742 $string = nsb_clean($_);
2749 my $NSB = '\x88'; # NSB : begin Non Sorting Block
2750 my $NSE = '\x89'; # NSE : Non Sorting Block end
2751 # handles non sorting blocks
2755 s/[ ]{0,1}$NSE/) /gm;
2762 my $dbh = C4::Context->dbh;
2763 my $result = MARCmarc2koha($dbh,$record,'');
2765 my ($biblionumber,$bibid,$title);
2766 # search duplicate on ISBN, easy and fast...
2767 if ($result->{isbn}) {
2768 $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=?");
2769 $sth->execute($result->{'isbn'});
2770 ($biblionumber,$bibid,$title) = $sth->fetchrow;
2771 return $biblionumber,$bibid,$title if ($biblionumber);
2773 # a more complex search : build a request for SearchMarc::catalogsearch()
2774 my (@tags, @and_or, @excluding, @operator, @value, $offset,$length);
2775 # search on biblio.title
2776 my ($tag,$subfield) = MARCfind_marc_from_kohafield($dbh,"biblio.title","");
2777 if ($record->field($tag)) {
2778 if ($record->field($tag)->subfields($subfield)) {
2779 push @tags, "'".$tag.$subfield."'";
2780 push @and_or, "and";
2781 push @excluding, "";
2782 push @operator, "contains";
2783 push @value, $record->field($tag)->subfield($subfield);
2784 # warn "for title, I add $tag / $subfield".$record->field($tag)->subfield($subfield);
2787 # ... and on biblio.author
2788 ($tag,$subfield) = MARCfind_marc_from_kohafield($dbh,"biblio.author","");
2789 if ($record->field($tag)) {
2790 if ($record->field($tag)->subfields($subfield)) {
2791 push @tags, "'".$tag.$subfield."'";
2792 push @and_or, "and";
2793 push @excluding, "";
2794 push @operator, "contains";
2795 push @value, $record->field($tag)->subfield($subfield);
2796 # warn "for author, I add $tag / $subfield".$record->field($tag)->subfield($subfield);
2799 # ... and on publicationyear.
2800 ($tag,$subfield) = MARCfind_marc_from_kohafield($dbh,"biblioitems.publicationyear","");
2801 if ($record->field($tag)) {
2802 if ($record->field($tag)->subfields($subfield)) {
2803 push @tags, "'".$tag.$subfield."'";
2804 push @and_or, "and";
2805 push @excluding, "";
2806 push @operator, "=";
2807 push @value, $record->field($tag)->subfield($subfield);
2808 # warn "for publicationyear, I add $tag / $subfield".$record->field($tag)->subfield($subfield);
2812 ($tag,$subfield) = MARCfind_marc_from_kohafield($dbh,"biblioitems.size","");
2813 if ($record->field($tag)) {
2814 if ($record->field($tag)->subfields($subfield)) {
2815 push @tags, "'".$tag.$subfield."'";
2816 push @and_or, "and";
2817 push @excluding, "";
2818 push @operator, "=";
2819 push @value, $record->field($tag)->subfield($subfield);
2820 # warn "for size, I add $tag / $subfield".$record->field($tag)->subfield($subfield);
2823 # ... and on publisher.
2824 ($tag,$subfield) = MARCfind_marc_from_kohafield($dbh,"biblioitems.publishercode","");
2825 if ($record->field($tag)) {
2826 if ($record->field($tag)->subfields($subfield)) {
2827 push @tags, "'".$tag.$subfield."'";
2828 push @and_or, "and";
2829 push @excluding, "";
2830 push @operator, "=";
2831 push @value, $record->field($tag)->subfield($subfield);
2832 # warn "for publishercode, I add $tag / $subfield".$record->field($tag)->subfield($subfield);
2835 # ... and on volume.
2836 ($tag,$subfield) = MARCfind_marc_from_kohafield($dbh,"biblioitems.volume","");
2837 if ($record->field($tag)) {
2838 if ($record->field($tag)->subfields($subfield)) {
2839 push @tags, "'".$tag.$subfield."'";
2840 push @and_or, "and";
2841 push @excluding, "";
2842 push @operator, "=";
2843 push @value, $record->field($tag)->subfield($subfield);
2844 # warn "for volume, I add $tag / $subfield".$record->field($tag)->subfield($subfield);
2848 my ($finalresult,$nbresult) = C4::SearchMarc::catalogsearch($dbh,\@tags,\@and_or,\@excluding,\@operator,\@value,0,10);
2849 # there is at least 1 result => return the 1st one
2851 # warn "$nbresult => ".@$finalresult[0]->{biblionumber},@$finalresult[0]->{bibid},@$finalresult[0]->{title};
2852 return @$finalresult[0]->{biblionumber},@$finalresult[0]->{bibid},@$finalresult[0]->{title};
2854 # no result, returns nothing
2861 if(substr($isbn, 0, 1) <=7) {
2862 $seg1 = substr($isbn, 0, 1);
2863 } elsif(substr($isbn, 0, 2) <= 94) {
2864 $seg1 = substr($isbn, 0, 2);
2865 } elsif(substr($isbn, 0, 3) <= 995) {
2866 $seg1 = substr($isbn, 0, 3);
2867 } elsif(substr($isbn, 0, 4) <= 9989) {
2868 $seg1 = substr($isbn, 0, 4);
2870 $seg1 = substr($isbn, 0, 5);
2872 my $x = substr($isbn, length($seg1));
2874 if(substr($x, 0, 2) <= 19) {
2875 # if(sTmp2 < 10) sTmp2 = "0" sTmp2;
2876 $seg2 = substr($x, 0, 2);
2877 } elsif(substr($x, 0, 3) <= 699) {
2878 $seg2 = substr($x, 0, 3);
2879 } elsif(substr($x, 0, 4) <= 8399) {
2880 $seg2 = substr($x, 0, 4);
2881 } elsif(substr($x, 0, 5) <= 89999) {
2882 $seg2 = substr($x, 0, 5);
2883 } elsif(substr($x, 0, 6) <= 9499999) {
2884 $seg2 = substr($x, 0, 6);
2886 $seg2 = substr($x, 0, 7);
2888 my $seg3=substr($x,length($seg2));
2889 $seg3=substr($seg3,0,length($seg3)-1) ;
2890 my $seg4 = substr($x, -1, 1);
2891 return "$seg1-$seg2-$seg3-$seg4";
2895 END { } # module clean-up code here (global destructor)
2901 Koha Developement team <info@koha.org>
2903 Paul POULAIN paul.poulain@free.fr
2909 # Revision 1.136 2006/01/10 17:01:29 tipaul
2910 # adding a XMLgetbiblio in Biblio.pm (1st draft, to use with zebra)
2912 # Revision 1.135 2006/01/06 16:39:37 tipaul
2913 # synch'ing head and rel_2_2 (from 2.2.5, including npl templates)
2914 # Seems not to break too many things, but i'm probably wrong here.
2915 # at least, new features/bugfixes from 2.2.5 are here (tested on some features on my head local copy)
2917 # - removing useless directories (koha-html and koha-plucene)
2919 # Revision 1.134 2006/01/04 15:54:55 tipaul
2920 # utf8 is a : go for beta test in HEAD.
2921 # some explanations :
2922 # - 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.
2923 # - *-top.inc will show the pages in utf8
2924 # - 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.
2925 # - using marcxml field and no more the iso2709 raw marc biblioitems.marc field.
2927 # Revision 1.133 2005/12/12 14:25:51 thd
2930 # Reverse array filled with elements from repeated subfields
2931 # to avoid last to first concatenation of elements in Koha DB.-
2933 # Revision 1.132 2005-10-26 09:12:33 tipaul
2934 # big commit, still breaking things...
2936 # * synch with rel_2_2. Probably the last non manual synch, as rel_2_2 should not be modified deeply.
2937 # * code cleaning (cleaning warnings from perl -w) continued
2939 # Revision 1.131 2005/09/22 10:01:45 tipaul
2940 # see mail on koha-devel : code cleaning on Search.pm + normalizing API + use of biblionumber everywhere (instead of bn, biblio, ...)
2942 # Revision 1.130 2005/09/02 14:34:14 tipaul
2943 # continuing the work to move to zebra. Begin of work for MARC=OFF support.
2944 # IMPORTANT NOTE : the MARCkoha2marc sub API has been modified. Instead of biblionumber & biblioitemnumber, it now gets a hash.
2945 # The sub is used only in Biblio.pm, so the API change should be harmless (except for me, but i'm aware ;-) )
2947 # Revision 1.129 2005/08/12 13:50:31 tipaul
2948 # removing useless sub declarations
2950 # Revision 1.128 2005/08/11 16:12:47 tipaul
2951 # Playing with the zebra...
2953 # * go to koha cvs home directory
2954 # * in misc/zebra there is a unimarc directory. I suggest that marc21 libraries create a marc21 directory
2955 # * put your zebra.cfg files here & create your database.
2956 # * from koha cvs home directory, ln -s misc/zebra/marc21 zebra (I mean create a symbolic link to YOUR zebra directory)
2957 # * now, everytime you add/modify a biblio/item your zebra DB is updated correctly.
2960 # * this uses a system call in perl. CPU consumming, but we are waiting for indexdata Perl/zoom
2961 # * deletion still not work
2962 # * UNIMARC zebra config files are provided in misc/zebra/unimarc directory. The most important line being :
2964 # recordId: (bib1,Local-number)
2968 # elm 090 Local-number -
2969 # elm 090/? Local-number -
2970 # elm 090/?/9 Local-number !:w
2972 # (090$9 being the field mapped to biblio.biblionumber in Koha)
2974 # Revision 1.127 2005/08/11 14:37:32 tipaul
2976 # * removing useless subs
2977 # * removing some subs that are also elsewhere
2978 # * 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)
2980 # Revision 1.126 2005/08/11 09:13:28 tipaul
2981 # just removing useless subs (a lot !!!) for code cleaning
2983 # Revision 1.125 2005/08/11 09:00:07 tipaul
2984 # Ok guys, this time, it seems that item add and modif begin working as expected...
2985 # Still a lot of bugs to fix, of course
2987 # Revision 1.124 2005/08/10 10:21:15 tipaul
2988 # continuing the road to zebra :
2989 # - the biblio add begins to work.
2990 # - the biblio modif begins to work.
2992 # (still without doing anything on zebra)
2993 # (no new change in updatedatabase)
2995 # Revision 1.123 2005/08/09 14:10:28 tipaul
2996 # 1st commit to go to zebra.
2997 # don't update your cvs if you want to have a working head...
2999 # this commit contains :
3000 # * 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...
3001 # * 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.
3002 # * other files : get rid of bibid and use biblionumber instead.
3005 # * does not do anything on zebra yet.
3006 # * if you rename marc_subfield_table, you can't search anymore.
3007 # * you can view a biblio & bibliodetails, go to MARC editor, but NOT save any modif.
3008 # * 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 ;-) )
3010 # 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
3011 # 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.
3013 # tipaul cutted previous commit notes