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;
187 $forlibrarian = 1 unless $forlibrarian;
189 my $libfield = ( $forlibrarian eq 1 ) ? 'liblibrarian' : 'libopac';
191 # check that framework exists
194 "select count(*) from marc_tag_structure where frameworkcode=?");
195 $sth->execute($frameworkcode);
196 my ($total) = $sth->fetchrow;
197 $frameworkcode = "" unless ( $total > 0 );
200 "select tagfield,liblibrarian,libopac,mandatory,repeatable from marc_tag_structure where frameworkcode=? order by tagfield"
202 $sth->execute($frameworkcode);
203 my ( $liblibrarian, $libopac, $tag, $res, $tab, $mandatory, $repeatable );
205 while ( ( $tag, $liblibrarian, $libopac, $mandatory, $repeatable ) = $sth->fetchrow ) {
206 $res->{$tag}->{lib} = ($forlibrarian or !$libopac)?$liblibrarian:$libopac;
207 $res->{$tag}->{tab} = ""; # XXX
208 $res->{$tag}->{mandatory} = $mandatory;
209 $res->{$tag}->{repeatable} = $repeatable;
214 "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"
216 $sth->execute($frameworkcode);
219 my $authorised_value;
229 ( $tag, $subfield, $liblibrarian, , $libopac, $tab,
230 $mandatory, $repeatable, $authorised_value, $authtypecode,
231 $value_builder, $kohafield, $seealso, $hidden,
236 $res->{$tag}->{$subfield}->{lib} = ($forlibrarian or !$libopac)?$liblibrarian:$libopac;
237 $res->{$tag}->{$subfield}->{tab} = $tab;
238 $res->{$tag}->{$subfield}->{mandatory} = $mandatory;
239 $res->{$tag}->{$subfield}->{repeatable} = $repeatable;
240 $res->{$tag}->{$subfield}->{authorised_value} = $authorised_value;
241 $res->{$tag}->{$subfield}->{authtypecode} = $authtypecode;
242 $res->{$tag}->{$subfield}->{value_builder} = $value_builder;
243 $res->{$tag}->{$subfield}->{kohafield} = $kohafield;
244 $res->{$tag}->{$subfield}->{seealso} = $seealso;
245 $res->{$tag}->{$subfield}->{hidden} = $hidden;
246 $res->{$tag}->{$subfield}->{isurl} = $isurl;
247 $res->{$tag}->{$subfield}->{link} = $link;
252 =head2 ($tagfield,$tagsubfield) = &MARCfind_marc_from_kohafield($dbh,$kohafield);
256 finds MARC tag and subfield for a given kohafield
257 kohafield is "table.field" where table= biblio|biblioitems|items, and field a field of the previous table
263 sub MARCfind_marc_from_kohafield {
264 my ( $dbh, $kohafield,$frameworkcode ) = @_;
265 return 0, 0 unless $kohafield;
266 $frameworkcode='' unless $frameworkcode;
267 my $relations = C4::Context->marcfromkohafield;
268 return ($relations->{$frameworkcode}->{$kohafield}->[0],$relations->{$frameworkcode}->{$kohafield}->[1]);
271 =head2 $MARCRecord = &MARCgetbiblio($dbh,$biblionumber);
275 Returns a MARC::Record for the biblio $biblionumber.
281 # Returns MARC::Record of the biblio passed in parameter.
282 my ( $dbh, $biblionumber ) = @_;
283 my $sth = $dbh->prepare('select marc from biblioitems where biblionumber=?');
284 $sth->execute($biblionumber);
285 my ($marc) = $sth->fetchrow;
286 my $record = MARC::Record::new_from_usmarc($marc);
290 =head2 $XML = &XMLgetbiblio($dbh,$biblionumber);
294 Returns a raw XML for the biblio $biblionumber.
300 # Returns MARC::Record of the biblio passed in parameter.
301 my ( $dbh, $biblionumber ) = @_;
302 my $sth = $dbh->prepare('select marcxml,marc from biblioitems where biblionumber=?');
303 $sth->execute($biblionumber);
304 my ($XML,$marc) = $sth->fetchrow;
305 # my $record =MARC::Record::new_from_usmarc($marc);
306 # warn "MARC : \n*-************************\n".$record->as_xml."\n*-************************\n";
310 =head2 $MARCrecord = &MARCgetitem($dbh,$biblionumber);
314 Returns a MARC::Record with all items of biblio # $biblionumber
322 my ( $dbh, $biblionumber, $itemnumber ) = @_;
323 my $frameworkcode=MARCfind_frameworkcode($dbh,$biblionumber);
324 # get the complete MARC record
325 my $sth = $dbh->prepare("select marc from biblioitems where biblionumber=?");
326 $sth->execute($biblionumber);
327 my ($rawmarc) = $sth->fetchrow;
328 my $record = MARC::File::USMARC::decode($rawmarc);
329 # now, find the relevant itemnumber
330 my ($itemnumberfield,$itemnumbersubfield) = MARCfind_marc_from_kohafield($dbh,'items.itemnumber',$frameworkcode);
331 # prepare the new item record
332 my $itemrecord = MARC::Record->new();
333 # parse all fields fields from the complete record
334 foreach ($record->field($itemnumberfield)) {
335 # when the item field is found, save it
336 if ($_->subfield($itemnumbersubfield) == $itemnumber) {
337 $itemrecord->append_fields($_);
344 =head2 sub find_biblioitemnumber($dbh,$biblionumber);
348 Returns the 1st biblioitemnumber related to $biblionumber. When MARC=ON we should have 1 biblionumber = 1 and only 1 biblioitemnumber
349 This sub is useless when MARC=OFF
354 sub find_biblioitemnumber {
355 my ( $dbh, $biblionumber ) = @_;
356 my $sth = $dbh->prepare("select biblioitemnumber from biblioitems where biblionumber=?");
357 $sth->execute($biblionumber);
358 my ($biblioitemnumber) = $sth->fetchrow;
359 return $biblioitemnumber;
362 =head2 $frameworkcode = MARCfind_frameworkcode($dbh,$biblionumber);
366 returns the framework of a given biblio
372 sub MARCfind_frameworkcode {
373 my ( $dbh, $biblionumber ) = @_;
374 my $sth = $dbh->prepare("select frameworkcode from biblio where biblionumber=?");
375 $sth->execute($biblionumber);
376 my ($frameworkcode) = $sth->fetchrow;
377 return $frameworkcode;
380 =head2 $MARCRecord = &MARCkoha2marcBiblio($dbh,$bibliohash);
384 MARCkoha2marcBiblio is a wrapper between old-DB and MARC-DB. It returns a MARC::Record builded with old-DB biblio/biblioitem :
385 all entries of the hash are transformed into their matching MARC field/subfield.
391 sub MARCkoha2marcBiblio {
393 # this function builds partial MARC::Record from the old koha-DB fields
394 my ( $dbh, $bibliohash ) = @_;
395 # we don't have biblio entries in the hash, so we add them first
396 my $sth = $dbh->prepare("select * from biblio where biblionumber=?");
397 $sth->execute($bibliohash->{biblionumber});
398 my $biblio = $sth->fetchrow_hashref;
399 foreach (keys %$biblio) {
400 $bibliohash->{$_}=$biblio->{$_};
402 $sth = $dbh->prepare("select tagfield,tagsubfield from marc_subfield_structure where frameworkcode=? and kohafield=?");
403 my $record = MARC::Record->new();
404 foreach ( keys %$bibliohash ) {
405 &MARCkoha2marcOnefield( $sth, $record, "biblio." . $_, $bibliohash->{$_}, '') if $bibliohash->{$_};
406 &MARCkoha2marcOnefield( $sth, $record, "biblioitems." . $_, $bibliohash->{$_}, '') if $bibliohash->{$_};
409 # other fields => additional authors, subjects, subtitles
410 my $sth2 = $dbh->prepare(" SELECT author FROM additionalauthors WHERE biblionumber=?");
411 $sth2->execute($bibliohash->{biblionumber});
412 while ( my $row = $sth2->fetchrow_hashref ) {
413 &MARCkoha2marcOnefield( $sth, $record, "additionalauthors.author", $bibliohash->{'author'},'' );
415 $sth2 = $dbh->prepare(" SELECT subject FROM bibliosubject WHERE biblionumber=?");
416 $sth2->execute($bibliohash->{biblionumber});
417 while ( my $row = $sth2->fetchrow_hashref ) {
418 &MARCkoha2marcOnefield( $sth, $record, "bibliosubject.subject", $row->{'subject'},'' );
420 $sth2 = $dbh->prepare(" SELECT subtitle FROM bibliosubtitle WHERE biblionumber=?");
421 $sth2->execute($bibliohash->{biblionumber});
422 while ( my $row = $sth2->fetchrow_hashref ) {
423 &MARCkoha2marcOnefield( $sth, $record, "bibliosubtitle.subtitle", $row->{'subtitle'},'' );
429 =head2 $MARCRecord = &MARCkoha2marcItem($dbh,$biblionumber,itemnumber);
431 MARCkoha2marcItem is a wrapper between old-DB and MARC-DB. It returns a MARC::Record builded with old-DB items :
432 all entries of the hash are transformed into their matching MARC field/subfield.
440 sub MARCkoha2marcItem {
442 # this function builds partial MARC::Record from the old koha-DB fields
443 my ( $dbh, $item ) = @_;
445 # my $dbh=&C4Connect;
446 my $sth = $dbh->prepare("select tagfield,tagsubfield from marc_subfield_structure where frameworkcode=? and kohafield=?");
447 my $record = MARC::Record->new();
449 foreach( keys %$item ) {
451 &MARCkoha2marcOnefield( $sth, $record, "items." . $_,
458 =head2 MARCkoha2marcOnefield
462 This sub is for internal use only, used by koha2marcBiblio & koha2marcItem
468 sub MARCkoha2marcOnefield {
469 my ( $sth, $record, $kohafieldname, $value,$frameworkcode ) = @_;
472 $sth->execute($frameworkcode,$kohafieldname);
473 if ( ( $tagfield, $tagsubfield ) = $sth->fetchrow ) {
474 if ( $record->field($tagfield) ) {
475 my $tag = $record->field($tagfield);
477 $tag->add_subfields( $tagsubfield, $value );
478 $record->delete_field($tag);
479 $record->add_fields($tag);
483 $record->add_fields( $tagfield, " ", " ", $tagsubfield => $value );
489 =head2 $MARCrecord = MARChtml2marc($dbh,$rtags,$rsubfields,$rvalues,%indicators);
493 transforms the parameters (coming from HTML form) into a MARC::Record
494 parameters with r are references to arrays.
496 FIXME : should be improved for 3.0, to avoid having 4 differents arrays
503 my ($dbh,$rtags,$rsubfields,$rvalues,%indicators) = @_;
505 my $record = MARC::Record->new();
506 # my %subfieldlist=();
507 my $prevvalue; # if tag <10
508 my $field; # if tag >=10
509 for (my $i=0; $i< @$rtags; $i++) {
510 next unless @$rvalues[$i];
511 # rebuild MARC::Record
512 # warn "0=>".@$rtags[$i].@$rsubfields[$i]." = ".@$rvalues[$i].": ";
513 if (@$rtags[$i] ne $prevtag) {
516 if ($prevtag ne '000') {
517 $record->add_fields((sprintf "%03s",$prevtag),$prevvalue);
519 $record->leader($prevvalue);
524 $record->add_fields($field);
527 $indicators{@$rtags[$i]}.=' ';
528 if (@$rtags[$i] <10) {
529 $prevvalue= @$rvalues[$i];
533 $field = MARC::Field->new( (sprintf "%03s",@$rtags[$i]), substr($indicators{@$rtags[$i]},0,1),substr($indicators{@$rtags[$i]},1,1), @$rsubfields[$i] => @$rvalues[$i]);
534 # warn "1=>".@$rtags[$i].@$rsubfields[$i]." = ".@$rvalues[$i].": ".$field->as_formatted;
536 $prevtag = @$rtags[$i];
538 if (@$rtags[$i] <10) {
539 $prevvalue=@$rvalues[$i];
541 if (length(@$rvalues[$i])>0) {
542 $field->add_subfields(@$rsubfields[$i] => @$rvalues[$i]);
543 # warn "2=>".@$rtags[$i].@$rsubfields[$i]." = ".@$rvalues[$i].": ".$field->as_formatted;
546 $prevtag= @$rtags[$i];
549 # the last has not been included inside the loop... do it now !
550 $record->add_fields($field) if $field;
551 # warn "HTML2MARC=".$record->as_formatted;
556 =head2 $hash = &MARCmarc2koha($dbh,$MARCRecord);
560 builds a hash with old-db datas from a MARC::Record
567 my ($dbh,$record,$frameworkcode) = @_;
568 my $sth=$dbh->prepare("select tagfield,tagsubfield from marc_subfield_structure where frameworkcode=? and kohafield=?");
570 my $sth2=$dbh->prepare("SHOW COLUMNS from biblio");
573 while (($field)=$sth2->fetchrow) {
574 # warn "biblio.".$field;
575 $result=&MARCmarc2kohaOneField($sth,"biblio",$field,$record,$result,$frameworkcode);
577 $sth2=$dbh->prepare("SHOW COLUMNS from biblioitems");
579 while (($field)=$sth2->fetchrow) {
580 if ($field eq 'notes') { $field = 'bnotes'; }
581 # warn "biblioitems".$field;
582 $result=&MARCmarc2kohaOneField($sth,"biblioitems",$field,$record,$result,$frameworkcode);
584 $sth2=$dbh->prepare("SHOW COLUMNS from items");
586 while (($field)=$sth2->fetchrow) {
587 # warn "items".$field;
588 $result=&MARCmarc2kohaOneField($sth,"items",$field,$record,$result,$frameworkcode);
590 # additional authors : specific
591 $result = &MARCmarc2kohaOneField($sth,"bibliosubtitle","subtitle",$record,$result,$frameworkcode);
592 $result = &MARCmarc2kohaOneField($sth,"additionalauthors","additionalauthors",$record,$result,$frameworkcode);
593 # modify copyrightdate to keep only the 1st year found
594 my $temp = $result->{'copyrightdate'};
596 $temp =~ m/c(\d\d\d\d)/; # search cYYYY first
598 $result->{'copyrightdate'} = $1;
599 } else { # if no cYYYY, get the 1st date.
600 $temp =~ m/(\d\d\d\d)/;
601 $result->{'copyrightdate'} = $1;
604 # modify publicationyear to keep only the 1st year found
605 $temp = $result->{'publicationyear'};
606 $temp =~ m/c(\d\d\d\d)/; # search cYYYY first
608 $result->{'publicationyear'} = $1;
609 } else { # if no cYYYY, get the 1st date.
610 $temp =~ m/(\d\d\d\d)/;
611 $result->{'publicationyear'} = $1;
616 sub MARCmarc2kohaOneField {
618 # FIXME ? if a field has a repeatable subfield that is used in old-db, only the 1st will be retrieved...
619 my ( $sth, $kohatable, $kohafield, $record, $result,$frameworkcode ) = @_;
620 # warn "kohatable / $kohafield / $result / ";
624 ( $tagfield, $subfield ) = MARCfind_marc_from_kohafield("",$kohatable.".".$kohafield,$frameworkcode);
625 foreach my $field ( $record->field($tagfield) ) {
626 if ($field->tag()<10) {
627 if ($result->{$kohafield}) {
628 # Reverse array filled with elements from repeated subfields
629 # from first to last to avoid last to first concatenation of
630 # elements in Koha DB. -- thd.
631 $result->{$kohafield} .= " | ".reverse($field->data());
633 $result->{$kohafield} = $field->data();
636 if ( $field->subfields ) {
637 my @subfields = $field->subfields();
638 foreach my $subfieldcount ( 0 .. $#subfields ) {
639 if ($subfields[$subfieldcount][0] eq $subfield) {
640 if ( $result->{$kohafield} ) {
641 $result->{$kohafield} .= " | " . $subfields[$subfieldcount][1];
644 $result->{$kohafield} = $subfields[$subfieldcount][1];
651 # warn "OneField for $kohatable.$kohafield and $frameworkcode=> $tagfield, $subfield";
655 =head2 ($biblionumber,$biblioitemnumber) = NEWnewbibilio($dbh,$MARCRecord,$frameworkcode);
659 creates a biblio from a MARC::Record.
666 my ( $dbh, $record, $frameworkcode ) = @_;
668 my $biblioitemnumber;
669 my $olddata = MARCmarc2koha( $dbh, $record,$frameworkcode );
670 $olddata->{frameworkcode} = $frameworkcode;
671 $biblionumber = REALnewbiblio( $dbh, $olddata );
672 $olddata->{biblionumber} = $biblionumber;
673 # add biblionumber into the MARC record (it's the ID for zebra)
674 my ( $tagfield, $tagsubfield ) =
675 MARCfind_marc_from_kohafield( $dbh, "biblio.biblionumber",$frameworkcode );
679 $newfield = MARC::Field->new(
680 $tagfield, $biblionumber,
683 $newfield = MARC::Field->new(
684 $tagfield, '', '', "$tagsubfield" => $biblionumber,
687 # drop old field (just in case it already exist and create new one...
688 my $old_field = $record->field($tagfield);
689 $record->delete_field($old_field);
690 $record->add_fields($newfield);
692 #create the marc entry, that stores the rax marc record in Koha 3.0
693 $olddata->{marc} = $record->as_usmarc();
694 $olddata->{marcxml} = $record->as_xml();
695 # and create biblioitem, that's all folks !
696 $biblioitemnumber = REALnewbiblioitem( $dbh, $olddata );
698 # search subtiles, addiauthors and subjects
699 ( $tagfield, $tagsubfield ) =
700 MARCfind_marc_from_kohafield( $dbh, "additionalauthors.author",$frameworkcode );
701 my @addiauthfields = $record->field($tagfield);
702 foreach my $addiauthfield (@addiauthfields) {
703 my @addiauthsubfields = $addiauthfield->subfield($tagsubfield);
704 foreach my $subfieldcount ( 0 .. $#addiauthsubfields ) {
705 REALmodaddauthor( $dbh, $biblionumber,
706 $addiauthsubfields[$subfieldcount] );
709 ( $tagfield, $tagsubfield ) =
710 MARCfind_marc_from_kohafield( $dbh, "bibliosubtitle.subtitle",$frameworkcode );
711 my @subtitlefields = $record->field($tagfield);
712 foreach my $subtitlefield (@subtitlefields) {
713 my @subtitlesubfields = $subtitlefield->subfield($tagsubfield);
714 foreach my $subfieldcount ( 0 .. $#subtitlesubfields ) {
715 REALnewsubtitle( $dbh, $biblionumber,
716 $subtitlesubfields[$subfieldcount] );
719 ( $tagfield, $tagsubfield ) =
720 MARCfind_marc_from_kohafield( $dbh, "bibliosubject.subject",$frameworkcode );
721 my @subj = $record->field($tagfield);
723 foreach my $subject (@subj) {
724 my @subjsubfield = $subject->subfield($tagsubfield);
725 foreach my $subfieldcount ( 0 .. $#subjsubfield ) {
726 push @subjects, $subjsubfield[$subfieldcount];
729 REALmodsubject( $dbh, $biblionumber, 1, @subjects );
730 return ( $biblionumber, $biblioitemnumber );
733 =head2 NEWmodbilbioframework($dbh,$biblionumber,$frameworkcode);
737 modify the framework of a biblio
743 sub NEWmodbiblioframework {
744 my ($dbh,$biblionumber,$frameworkcode) =@_;
745 my $sth = $dbh->prepare("Update biblio SET frameworkcode=? WHERE biblionumber=?");
746 $sth->execute($frameworkcode,$biblionumber);
750 =head2 NEWmodbiblio($dbh,$MARCrecord,$biblionumber,$frameworkcode);
754 modify a biblio (MARC=ON)
761 my ($dbh,$record,$biblionumber,$frameworkcode) =@_;
762 $frameworkcode="" unless $frameworkcode;
763 # &MARCmodbiblio($dbh,$bibid,$record,$frameworkcode,0);
764 my $oldbiblio = MARCmarc2koha($dbh,$record,$frameworkcode);
766 $oldbiblio->{frameworkcode} = $frameworkcode;
767 #create the marc entry, that stores the rax marc record in Koha 3.0
768 $oldbiblio->{marc} = $record->as_usmarc();
769 $oldbiblio->{marcxml} = $record->as_xml();
771 REALmodbiblio($dbh,$oldbiblio);
772 REALmodbiblioitem($dbh,$oldbiblio);
773 # now, modify addi authors, subject, addititles.
774 my ($tagfield,$tagsubfield) = MARCfind_marc_from_kohafield($dbh,"additionalauthors.author",$frameworkcode);
775 my @addiauthfields = $record->field($tagfield);
776 foreach my $addiauthfield (@addiauthfields) {
777 my @addiauthsubfields = $addiauthfield->subfield($tagsubfield);
778 $dbh->do("delete from additionalauthors where biblionumber=$biblionumber");
779 foreach my $subfieldcount (0..$#addiauthsubfields) {
780 REALmodaddauthor($dbh,$biblionumber,$addiauthsubfields[$subfieldcount]);
783 ($tagfield,$tagsubfield) = MARCfind_marc_from_kohafield($dbh,"bibliosubtitle.subtitle",$frameworkcode);
784 my @subtitlefields = $record->field($tagfield);
785 foreach my $subtitlefield (@subtitlefields) {
786 my @subtitlesubfields = $subtitlefield->subfield($tagsubfield);
787 # delete & create subtitle again because REALmodsubtitle can't handle new subtitles
789 $dbh->do("delete from bibliosubtitle where biblionumber=$biblionumber");
790 foreach my $subfieldcount (0..$#subtitlesubfields) {
791 foreach my $subtit(split /\||#/,$subtitlesubfields[$subfieldcount]) {
792 REALnewsubtitle($dbh,$biblionumber,$subtit);
796 ($tagfield,$tagsubfield) = MARCfind_marc_from_kohafield($dbh,"bibliosubject.subject",$frameworkcode);
797 my @subj = $record->field($tagfield);
799 foreach my $subject (@subj) {
800 my @subjsubfield = $subject->subfield($tagsubfield);
801 foreach my $subfieldcount (0..$#subjsubfield) {
802 push @subjects,$subjsubfield[$subfieldcount];
805 REALmodsubject($dbh,$biblionumber,1,@subjects);
809 =head2 NEWmodbilbioframework($dbh,$biblionumber,$frameworkcode);
820 my ( $dbh, $bibid ) = @_;
821 my $biblio = &MARCfind_oldbiblionumber_from_MARCbibid( $dbh, $bibid );
822 &REALdelbiblio( $dbh, $biblio );
825 "select biblioitemnumber from biblioitems where biblionumber=?");
826 $sth->execute($biblio);
827 while ( my ($biblioitemnumber) = $sth->fetchrow ) {
828 REALdelbiblioitem( $dbh, $biblioitemnumber );
830 &MARCdelbiblio( $dbh, $bibid, 0 );
833 =head2 $itemnumber = NEWnewitem($dbh, $record, $biblionumber, $biblioitemnumber);
837 creates an item from a MARC::Record
844 my ( $dbh, $record, $biblionumber, $biblioitemnumber ) = @_;
847 my $frameworkcode=MARCfind_frameworkcode($dbh,$biblionumber);
848 my $item = &MARCmarc2koha( $dbh, $record,$frameworkcode );
849 # needs old biblionumber and biblioitemnumber
850 $item->{'biblionumber'} = $biblionumber;
851 $item->{'biblioitemnumber'}=$biblioitemnumber;
852 $item->{marc} = $record->as_usmarc();
853 my ( $itemnumber, $error ) = &REALnewitems( $dbh, $item, $item->{barcode} );
858 =head2 $itemnumber = NEWmoditem($dbh, $record, $biblionumber, $biblioitemnumber,$itemnumber);
869 my ( $dbh, $record, $biblionumber, $biblioitemnumber, $itemnumber) = @_;
871 my $frameworkcode=MARCfind_frameworkcode($dbh,$biblionumber);
872 my $olditem = MARCmarc2koha( $dbh, $record,$frameworkcode );
874 $olditem->{marc} = $record->as_usmarc();
875 $olditem->{biblionumber} = $biblionumber;
876 $olditem->{biblioitemnumber} = $biblioitemnumber;
878 REALmoditem( $dbh, $olditem );
882 =head2 $itemnumber = NEWdelitem($dbh, $biblionumber, $biblioitemnumber, $itemnumber);
893 my ( $dbh, $bibid, $itemnumber ) = @_;
894 my $biblio = &MARCfind_oldbiblionumber_from_MARCbibid( $dbh, $bibid );
895 &REALdelitem( $dbh, $itemnumber );
896 &MARCdelitem( $dbh, $bibid, $itemnumber );
900 =head2 $biblionumber = REALnewbiblio($dbh,$biblio);
904 adds a record in biblio table. Datas are in the hash $biblio.
911 my ( $dbh, $biblio ) = @_;
913 $dbh->do('lock tables biblio WRITE');
914 my $sth = $dbh->prepare("Select max(biblionumber) from biblio");
916 my $data = $sth->fetchrow_arrayref;
917 my $bibnum = $$data[0] + 1;
920 if ( $biblio->{'seriestitle'} ) { $series = 1 }
923 $dbh->prepare("insert into biblio set biblionumber=?, title=?, author=?, copyrightdate=?,
924 serial=?, seriestitle=?, notes=?, abstract=?,
928 $bibnum, $biblio->{'title'},
929 $biblio->{'author'}, $biblio->{'copyrightdate'},
930 $biblio->{'serial'}, $biblio->{'seriestitle'},
931 $biblio->{'notes'}, $biblio->{'abstract'},
932 $biblio->{'unititle'}
936 $dbh->do('unlock tables');
940 =head2 $biblionumber = REALmodbiblio($dbh,$biblio);
944 modify a record in biblio table. Datas are in the hash $biblio.
951 my ( $dbh, $biblio ) = @_;
952 my $sth = $dbh->prepare("Update biblio set title=?, author=?, abstract=?, copyrightdate=?,
953 seriestitle=?, serial=?, unititle=?, notes=?, frameworkcode=?
954 where biblionumber = ?"
957 $biblio->{'title'}, $biblio->{'author'},
958 $biblio->{'abstract'}, $biblio->{'copyrightdate'},
959 $biblio->{'seriestitle'}, $biblio->{'serial'},
960 $biblio->{'unititle'}, $biblio->{'notes'},
961 $biblio->{frameworkcode},
962 $biblio->{'biblionumber'}
965 return ( $biblio->{'biblionumber'} );
968 =head2 REALmodsubtitle($dbh,$bibnum,$subtitle);
972 modify subtitles in bibliosubtitle table.
978 sub REALmodsubtitle {
979 my ( $dbh, $bibnum, $subtitle ) = @_;
982 "update bibliosubtitle set subtitle = ? where biblionumber = ?");
983 $sth->execute( $subtitle, $bibnum );
987 =head2 REALmodaddauthor($dbh,$bibnum,$author);
991 adds or modify additional authors
992 NOTE : Strange sub : seems to delete MANY and add only ONE author... maybe buggy ?
998 sub REALmodaddauthor {
999 my ( $dbh, $bibnum, @authors ) = @_;
1001 # my $dbh = C4Connect;
1003 $dbh->prepare("Delete from additionalauthors where biblionumber = ?");
1005 $sth->execute($bibnum);
1007 foreach my $author (@authors) {
1008 if ( $author ne '' ) {
1011 "Insert into additionalauthors set author = ?, biblionumber = ?"
1014 $sth->execute( $author, $bibnum );
1019 } # sub modaddauthor
1021 =head2 $errors = REALmodsubject($dbh,$bibnum, $force, @subject);
1025 modify/adds subjects
1030 sub REALmodsubject {
1031 my ( $dbh, $bibnum, $force, @subject ) = @_;
1033 # my $dbh = C4Connect;
1034 my $count = @subject;
1036 for ( my $i = 0 ; $i < $count ; $i++ ) {
1037 $subject[$i] =~ s/^ //g;
1038 $subject[$i] =~ s/ $//g;
1041 "select * from catalogueentry where entrytype = 's' and catalogueentry = ?"
1043 $sth->execute( $subject[$i] );
1045 if ( my $data = $sth->fetchrow_hashref ) {
1048 if ( $force eq $subject[$i] || $force == 1 ) {
1050 # subject not in aut, chosen to force anway
1051 # so insert into cataloguentry so its in auth file
1054 "Insert into catalogueentry (entrytype,catalogueentry) values ('s',?)"
1057 $sth2->execute( $subject[$i] ) if ( $subject[$i] );
1062 "$subject[$i]\n does not exist in the subject authority file";
1065 "Select * from catalogueentry where entrytype = 's' and (catalogueentry like ? or catalogueentry like ? or catalogueentry like ?)"
1067 $sth2->execute( "$subject[$i] %", "% $subject[$i] %",
1069 while ( my $data = $sth2->fetchrow_hashref ) {
1070 $error .= "<br>$data->{'catalogueentry'}";
1079 $dbh->prepare("Delete from bibliosubject where biblionumber = ?");
1080 $sth->execute($bibnum);
1084 "Insert into bibliosubject (subject,biblionumber) values (?,?)");
1086 foreach $query (@subject) {
1087 $sth->execute( $query, $bibnum ) if ( $query && $bibnum );
1096 =head2 REALmodbiblioitem($dbh, $biblioitem);
1105 sub REALmodbiblioitem {
1106 my ( $dbh, $biblioitem ) = @_;
1109 my $sth = $dbh->prepare("update biblioitems set number=?,volume=?, volumedate=?, lccn=?,
1110 itemtype=?, url=?, isbn=?, issn=?,
1111 publishercode=?, publicationyear=?, classification=?, dewey=?,
1112 subclass=?, illus=?, pages=?, volumeddesc=?,
1113 notes=?, size=?, place=?, marc=?,
1115 where biblioitemnumber=?");
1116 $sth->execute( $biblioitem->{number}, $biblioitem->{volume}, $biblioitem->{volumedate}, $biblioitem->{lccn},
1117 $biblioitem->{itemtype}, $biblioitem->{url}, $biblioitem->{isbn}, $biblioitem->{issn},
1118 $biblioitem->{publishercode}, $biblioitem->{publicationyear}, $biblioitem->{classification}, $biblioitem->{dewey},
1119 $biblioitem->{subclass}, $biblioitem->{illus}, $biblioitem->{pages}, $biblioitem->{volumeddesc},
1120 $biblioitem->{bnotes}, $biblioitem->{size}, $biblioitem->{place}, $biblioitem->{marc},
1121 $biblioitem->{marcxml}, $biblioitem->{biblioitemnumber});
1122 my $record = MARC::File::USMARC::decode($biblioitem->{marc});
1123 zebra_create($biblioitem->{biblionumber}, $record);
1124 # warn "MOD : $biblioitem->{biblioitemnumber} = ".$biblioitem->{marc};
1127 =head2 REALnewbiblioitem($dbh,$biblioitem);
1131 adds a biblioitem ($biblioitem is a hash with the values)
1137 sub REALnewbiblioitem {
1138 my ( $dbh, $biblioitem ) = @_;
1140 $dbh->do("lock tables biblioitems WRITE, biblio WRITE, marc_subfield_structure READ");
1141 my $sth = $dbh->prepare("Select max(biblioitemnumber) from biblioitems");
1143 my $biblioitemnumber;
1146 $data = $sth->fetchrow_arrayref;
1147 $biblioitemnumber = $$data[0] + 1;
1149 # Insert biblioitemnumber in MARC record, we need it to manage items later...
1150 my $frameworkcode=MARCfind_frameworkcode($dbh,$biblioitem->{biblionumber});
1151 my ($biblioitemnumberfield,$biblioitemnumbersubfield) = MARCfind_marc_from_kohafield($dbh,'biblioitems.biblioitemnumber',$frameworkcode);
1152 my $record = MARC::File::USMARC::decode($biblioitem->{marc});
1153 my $field=$record->field($biblioitemnumberfield);
1154 $field->update($biblioitemnumbersubfield => "$biblioitemnumber");
1155 $biblioitem->{marc} = $record->as_usmarc();
1156 $biblioitem->{marcxml} = $record->as_xml();
1158 $sth = $dbh->prepare( "insert into biblioitems set
1159 biblioitemnumber = ?, biblionumber = ?,
1160 volume = ?, number = ?,
1161 classification = ?, itemtype = ?,
1163 issn = ?, dewey = ?,
1164 subclass = ?, publicationyear = ?,
1165 publishercode = ?, volumedate = ?,
1166 volumeddesc = ?, illus = ?,
1167 pages = ?, notes = ?,
1169 marc = ?, place = ?,
1173 $biblioitemnumber, $biblioitem->{'biblionumber'},
1174 $biblioitem->{'volume'}, $biblioitem->{'number'},
1175 $biblioitem->{'classification'}, $biblioitem->{'itemtype'},
1176 $biblioitem->{'url'}, $biblioitem->{'isbn'},
1177 $biblioitem->{'issn'}, $biblioitem->{'dewey'},
1178 $biblioitem->{'subclass'}, $biblioitem->{'publicationyear'},
1179 $biblioitem->{'publishercode'}, $biblioitem->{'volumedate'},
1180 $biblioitem->{'volumeddesc'}, $biblioitem->{'illus'},
1181 $biblioitem->{'pages'}, $biblioitem->{'bnotes'},
1182 $biblioitem->{'size'}, $biblioitem->{'lccn'},
1183 $biblioitem->{'marc'}, $biblioitem->{'place'},
1184 $biblioitem->{marcxml},
1186 $dbh->do("unlock tables");
1187 zebra_create($biblioitem->{biblionumber}, $record);
1188 return ($biblioitemnumber);
1191 =head2 REALnewsubtitle($dbh,$bibnum,$subtitle);
1195 create a new subtitle
1200 sub REALnewsubtitle {
1201 my ( $dbh, $bibnum, $subtitle ) = @_;
1204 "insert into bibliosubtitle set biblionumber = ?, subtitle = ?");
1205 $sth->execute( $bibnum, $subtitle ) if $subtitle;
1209 =head2 ($itemnumber,$errors)= REALnewitems($dbh,$item,$barcode);
1213 create a item. $item is a hash and $barcode the barcode.
1220 my ( $dbh, $item, $barcode ) = @_;
1222 # warn "OLDNEWITEMS";
1224 $dbh->do('lock tables items WRITE, biblio WRITE,biblioitems WRITE,marc_subfield_structure WRITE');
1225 my $sth = $dbh->prepare("Select max(itemnumber) from items");
1230 $data = $sth->fetchrow_hashref;
1231 $itemnumber = $data->{'max(itemnumber)'} + 1;
1233 # FIXME the "notforloan" field seems to be named "loan" in some places. workaround bugfix.
1234 if ( $item->{'loan'} ) {
1235 $item->{'notforloan'} = $item->{'loan'};
1238 # if dateaccessioned is provided, use it. Otherwise, set to NOW()
1239 if ( $item->{'dateaccessioned'} ) {
1240 $sth = $dbh->prepare( "Insert into items set
1241 itemnumber = ?, biblionumber = ?,
1242 multivolumepart = ?,
1243 biblioitemnumber = ?, barcode = ?,
1244 booksellerid = ?, dateaccessioned = ?,
1245 homebranch = ?, holdingbranch = ?,
1246 price = ?, replacementprice = ?,
1247 replacementpricedate = NOW(), datelastseen = NOW(),
1248 multivolume = ?, stack = ?,
1249 itemlost = ?, wthdrawn = ?,
1250 paidfor = ?, itemnotes = ?,
1251 itemcallnumber =?, notforloan = ?,
1256 $itemnumber, $item->{'biblionumber'},
1257 $item->{'multivolumepart'},
1258 $item->{'biblioitemnumber'},$item->{barcode},
1259 $item->{'booksellerid'}, $item->{'dateaccessioned'},
1260 $item->{'homebranch'}, $item->{'holdingbranch'},
1261 $item->{'price'}, $item->{'replacementprice'},
1262 $item->{multivolume}, $item->{stack},
1263 $item->{itemlost}, $item->{wthdrawn},
1264 $item->{paidfor}, $item->{'itemnotes'},
1265 $item->{'itemcallnumber'}, $item->{'notforloan'},
1268 if ( defined $sth->errstr ) {
1269 $error .= $sth->errstr;
1273 $sth = $dbh->prepare( "Insert into items set
1274 itemnumber = ?, biblionumber = ?,
1275 multivolumepart = ?,
1276 biblioitemnumber = ?, barcode = ?,
1277 booksellerid = ?, dateaccessioned = NOW(),
1278 homebranch = ?, holdingbranch = ?,
1279 price = ?, replacementprice = ?,
1280 replacementpricedate = NOW(), datelastseen = NOW(),
1281 multivolume = ?, stack = ?,
1282 itemlost = ?, wthdrawn = ?,
1283 paidfor = ?, itemnotes = ?,
1284 itemcallnumber =?, notforloan = ?,
1289 $itemnumber, $item->{'biblionumber'},
1290 $item->{'multivolumepart'},
1291 $item->{'biblioitemnumber'},$item->{barcode},
1292 $item->{'booksellerid'},
1293 $item->{'homebranch'}, $item->{'holdingbranch'},
1294 $item->{'price'}, $item->{'replacementprice'},
1295 $item->{multivolume}, $item->{stack},
1296 $item->{itemlost}, $item->{wthdrawn},
1297 $item->{paidfor}, $item->{'itemnotes'},
1298 $item->{'itemcallnumber'}, $item->{'notforloan'},
1301 if ( defined $sth->errstr ) {
1302 $error .= $sth->errstr;
1305 # item stored, now, deal with the marc part...
1306 $sth = $dbh->prepare("select biblioitems.marc,biblio.frameworkcode from biblioitems,biblio
1307 where biblio.biblionumber=biblioitems.biblionumber and
1308 biblio.biblionumber=?");
1309 $sth->execute($item->{biblionumber});
1310 if ( defined $sth->errstr ) {
1311 $error .= $sth->errstr;
1313 my ($rawmarc,$frameworkcode) = $sth->fetchrow;
1314 warn "ERROR IN REALnewitem, MARC record not found FOR $item->{biblionumber} => $rawmarc <=" unless $rawmarc;
1315 my $record = MARC::File::USMARC::decode($rawmarc);
1316 # ok, we have the marc record, add item number to the item field (in {marc}, and add the field to the record)
1317 my ($itemnumberfield,$itemnumbersubfield) = MARCfind_marc_from_kohafield($dbh,'items.itemnumber',$frameworkcode);
1318 my $itemrecord = MARC::File::USMARC::decode($item->{marc});
1319 my $itemfield = $itemrecord->field($itemnumberfield);
1320 $itemfield->add_subfields($itemnumbersubfield => "$itemnumber");
1321 $record->insert_grouped_field($itemfield);
1322 # save the record into biblioitem
1323 $sth=$dbh->prepare("update biblioitems set marc=?,marcxml=? where biblionumber=?");
1324 $sth->execute($record->as_usmarc(),$record->as_xml(),$item->{biblionumber});
1325 if ( defined $sth->errstr ) {
1326 $error .= $sth->errstr;
1328 zebra_create($item->{biblionumber},$record);
1329 $dbh->do('unlock tables');
1330 return ( $itemnumber, $error );
1333 =head2 REALmoditem($dbh,$item);
1344 my ( $dbh, $item ) = @_;
1346 $dbh->do('lock tables items WRITE, biblio WRITE,biblioitems WRITE');
1347 $item->{'itemnum'} = $item->{'itemnumber'} unless $item->{'itemnum'};
1348 my $query = "update items set barcode=?,itemnotes=?,itemcallnumber=?,notforloan=?,location=?,multivolumepart=?,multivolume=?,stack=?,wthdrawn=?";
1350 $item->{'barcode'}, $item->{'itemnotes'},
1351 $item->{'itemcallnumber'}, $item->{'notforloan'},
1352 $item->{'location'}, $item->{multivolumepart},
1353 $item->{multivolume}, $item->{stack},
1356 if ( $item->{'lost'} ne '' ) {
1357 $query = "update items set biblioitemnumber=?,barcode=?,itemnotes=?,homebranch=?,
1358 itemlost=?,wthdrawn=?,itemcallnumber=?,notforloan=?,
1359 location=?,multivolumepart=?,multivolume=?,stack=?,wthdrawn=?";
1361 $item->{'bibitemnum'}, $item->{'barcode'},
1362 $item->{'itemnotes'}, $item->{'homebranch'},
1363 $item->{'lost'}, $item->{'wthdrawn'},
1364 $item->{'itemcallnumber'}, $item->{'notforloan'},
1365 $item->{'location'}, $item->{multivolumepart},
1366 $item->{multivolume}, $item->{stack},
1369 if ($item->{homebranch}) {
1370 $query.=",homebranch=?";
1371 push @bind, $item->{homebranch};
1373 if ($item->{holdingbranch}) {
1374 $query.=",holdingbranch=?";
1375 push @bind, $item->{holdingbranch};
1378 $query.=" where itemnumber=?";
1379 push @bind,$item->{'itemnum'};
1380 if ( $item->{'replacement'} ne '' ) {
1381 $query =~ s/ where/,replacementprice='$item->{'replacement'}' where/;
1383 my $sth = $dbh->prepare($query);
1384 $sth->execute(@bind);
1386 # item stored, now, deal with the marc part...
1387 $sth = $dbh->prepare("select biblioitems.marc,biblio.frameworkcode from biblioitems,biblio
1388 where biblio.biblionumber=biblioitems.biblionumber and
1389 biblio.biblionumber=? and
1390 biblioitems.biblioitemnumber=?");
1391 $sth->execute($item->{biblionumber},$item->{biblioitemnumber});
1392 if ( defined $sth->errstr ) {
1393 $error .= $sth->errstr;
1395 my ($rawmarc,$frameworkcode) = $sth->fetchrow;
1396 warn "ERROR IN REALmoditem, MARC record not found" unless $rawmarc;
1397 my $record = MARC::File::USMARC::decode($rawmarc);
1398 # ok, we have the marc record, find the previous item record for this itemnumber and delete it
1399 my ($itemnumberfield,$itemnumbersubfield) = MARCfind_marc_from_kohafield($dbh,'items.itemnumber',$frameworkcode);
1400 # prepare the new item record
1401 my $itemrecord = MARC::File::USMARC::decode($item->{marc});
1402 my $itemfield = $itemrecord->field($itemnumberfield);
1403 $itemfield->add_subfields($itemnumbersubfield => '$itemnumber');
1404 # parse all fields fields from the complete record
1405 foreach ($record->field($itemnumberfield)) {
1406 # when the previous field is found, replace by the new one
1407 if ($_->subfield($itemnumbersubfield) == $item->{itemnum}) {
1408 $_->replace_with($itemfield);
1411 # $record->insert_grouped_field($itemfield);
1412 # save the record into biblioitem
1413 $sth=$dbh->prepare("update biblioitems set marc=?,marcxml=? where biblionumber=? and biblioitemnumber=?");
1414 $sth->execute($record->as_usmarc(),$record->as_xml(),$item->{biblionumber},$item->{biblioitemnumber});
1415 zebra_create($item->biblionumber,$record);
1416 if ( defined $sth->errstr ) {
1417 $error .= $sth->errstr;
1419 $dbh->do('unlock tables');
1424 =head2 REALdelitem($dbh,$itemnum);
1435 my ( $dbh, $itemnum ) = @_;
1437 # my $dbh=C4Connect;
1438 my $sth = $dbh->prepare("select * from items where itemnumber=?");
1439 $sth->execute($itemnum);
1440 my $data = $sth->fetchrow_hashref;
1442 my $query = "Insert into deleteditems set ";
1444 foreach my $temp ( keys %$data ) {
1445 $query .= "$temp = ?,";
1446 push ( @bind, $data->{$temp} );
1451 $sth = $dbh->prepare($query);
1452 $sth->execute(@bind);
1454 $sth = $dbh->prepare("Delete from items where itemnumber=?");
1455 $sth->execute($itemnum);
1461 =head2 REALdelbiblioitem($dbh,$biblioitemnumber);
1465 deletes a biblioitem
1466 NOTE : not standard sub name. Should be REALdelbiblioitem()
1472 sub REALdelbiblioitem {
1473 my ( $dbh, $biblioitemnumber ) = @_;
1475 # my $dbh = C4Connect;
1476 my $sth = $dbh->prepare( "Select * from biblioitems
1477 where biblioitemnumber = ?"
1481 $sth->execute($biblioitemnumber);
1483 if ( $results = $sth->fetchrow_hashref ) {
1487 "Insert into deletedbiblioitems (biblioitemnumber, biblionumber, volume, number, classification, itemtype,
1488 isbn, issn ,dewey ,subclass ,publicationyear ,publishercode ,volumedate ,volumeddesc ,timestamp ,illus ,
1489 pages ,notes ,size ,url ,lccn ) values(?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)"
1493 $results->{biblioitemnumber}, $results->{biblionumber},
1494 $results->{volume}, $results->{number},
1495 $results->{classification}, $results->{itemtype},
1496 $results->{isbn}, $results->{issn},
1497 $results->{dewey}, $results->{subclass},
1498 $results->{publicationyear}, $results->{publishercode},
1499 $results->{volumedate}, $results->{volumeddesc},
1500 $results->{timestamp}, $results->{illus},
1501 $results->{pages}, $results->{notes},
1502 $results->{size}, $results->{url},
1506 $dbh->prepare("Delete from biblioitems where biblioitemnumber = ?");
1507 $sth2->execute($biblioitemnumber);
1512 # Now delete all the items attached to the biblioitem
1513 $sth = $dbh->prepare("Select * from items where biblioitemnumber = ?");
1514 $sth->execute($biblioitemnumber);
1516 while ( my $data = $sth->fetchrow_hashref ) {
1517 my $query = "Insert into deleteditems set ";
1519 foreach my $temp ( keys %$data ) {
1520 $query .= "$temp = ?,";
1521 push ( @bind, $data->{$temp} );
1524 my $sth2 = $dbh->prepare($query);
1525 $sth2->execute(@bind);
1528 $sth = $dbh->prepare("Delete from items where biblioitemnumber = ?");
1529 $sth->execute($biblioitemnumber);
1533 } # sub deletebiblioitem
1535 =head2 REALdelbiblio($dbh,$biblio);
1546 my ( $dbh, $biblio ) = @_;
1547 my $sth = $dbh->prepare("select * from biblio where biblionumber=?");
1548 $sth->execute($biblio);
1549 if ( my $data = $sth->fetchrow_hashref ) {
1551 my $query = "Insert into deletedbiblio set ";
1553 foreach my $temp ( keys %$data ) {
1554 $query .= "$temp = ?,";
1555 push ( @bind, $data->{$temp} );
1558 #replacing the last , by ",?)"
1560 $sth = $dbh->prepare($query);
1561 $sth->execute(@bind);
1563 $sth = $dbh->prepare("Delete from biblio where biblionumber=?");
1564 $sth->execute($biblio);
1570 =head2 $number = itemcount($biblio);
1574 returns the number of items attached to a biblio
1582 my $dbh = C4::Context->dbh;
1585 my $sth = $dbh->prepare("Select count(*) from items where biblionumber=?");
1586 $sth->execute($biblio);
1587 my $data = $sth->fetchrow_hashref;
1589 return ( $data->{'count(*)'} );
1592 =head2 $biblionumber = newbiblio($biblio);
1596 create a biblio. The parameter is a hash
1604 my $dbh = C4::Context->dbh;
1605 my $bibnum = REALnewbiblio( $dbh, $biblio );
1606 # finds new (MARC bibid
1607 # my $bibid = &MARCfind_MARCbibid_from_oldbiblionumber($dbh,$bibnum);
1608 # my $record = &MARCkoha2marcBiblio( $dbh, $bibnum );
1609 # MARCaddbiblio( $dbh, $record, $bibnum,'' );
1613 =head2 $biblionumber = &modbiblio($biblio);
1617 Update a biblio record.
1619 C<$biblio> is a reference-to-hash whose keys are the fields in the
1620 biblio table in the Koha database. All fields must be present, not
1621 just the ones you wish to change.
1623 C<&modbiblio> updates the record defined by
1624 C<$biblio-E<gt>{biblionumber}> with the values in C<$biblio>.
1626 C<&modbiblio> returns C<$biblio-E<gt>{biblionumber}> whether it was
1635 my $dbh = C4::Context->dbh;
1636 my $biblionumber=REALmodbiblio($dbh,$biblio);
1637 my $record = MARCkoha2marcBiblio($dbh,$biblionumber,$biblionumber);
1638 # finds new (MARC bibid
1639 my $bibid = &MARCfind_MARCbibid_from_oldbiblionumber($dbh,$biblionumber);
1640 MARCmodbiblio($dbh,$bibid,$record,"",0);
1641 return($biblionumber);
1644 =head2 &modsubtitle($biblionumber, $subtitle);
1648 Sets the subtitle of a book.
1650 C<$biblionumber> is the biblionumber of the book to modify.
1652 C<$subtitle> is the new subtitle.
1659 my ( $bibnum, $subtitle ) = @_;
1660 my $dbh = C4::Context->dbh;
1661 &REALmodsubtitle( $dbh, $bibnum, $subtitle );
1664 =head2 &modaddauthor($biblionumber, $author);
1668 Replaces all additional authors for the book with biblio number
1669 C<$biblionumber> with C<$author>. If C<$author> is the empty string,
1670 C<&modaddauthor> deletes all additional authors.
1677 my ( $bibnum, @authors ) = @_;
1678 my $dbh = C4::Context->dbh;
1679 &REALmodaddauthor( $dbh, $bibnum, @authors );
1680 } # sub modaddauthor
1682 =head2 $error = &modsubject($biblionumber, $force, @subjects);
1686 $force - a subject to force
1687 $error - Error message, or undef if successful.
1694 my ( $bibnum, $force, @subject ) = @_;
1695 my $dbh = C4::Context->dbh;
1696 my $error = &REALmodsubject( $dbh, $bibnum, $force, @subject );
1698 # When MARC is off, ensures that the MARC biblio table gets updated with new
1699 # subjects, of course, it deletes the biblio in marc, and then recreates.
1700 # This check is to ensure that no MARC data exists to lose.
1701 # if (C4::Context->preference("MARC") eq '0'){
1702 # warn "in modSUBJECT";
1703 # my $MARCRecord = &MARCkoha2marcBiblio($dbh,$bibnum);
1704 # my $bibid = &MARCfind_MARCbibid_from_oldbiblionumber($dbh,$bibnum);
1705 # &MARCmodbiblio($dbh,$bibid, $MARCRecord);
1711 =head2 modbibitem($biblioitem);
1715 modify a biblioitem. The parameter is a hash
1722 my ($biblioitem) = @_;
1723 my $dbh = C4::Context->dbh;
1724 &REALmodbiblioitem( $dbh, $biblioitem );
1727 =head2 $biblioitemnumber = newbiblioitem($biblioitem)
1731 create a biblioitem, the parameter is a hash
1738 my ($biblioitem) = @_;
1739 my $dbh = C4::Context->dbh;
1740 # add biblio information to the hash
1741 my $MARCbiblio = MARCkoha2marcBiblio( $dbh, $biblioitem );
1742 $biblioitem->{marc} = $MARCbiblio->as_usmarc();
1743 my $bibitemnum = &REALnewbiblioitem( $dbh, $biblioitem );
1744 return ($bibitemnum);
1747 =head2 newsubtitle($biblionumber,$subtitle);
1751 insert a subtitle for $biblionumber biblio
1759 my ( $bibnum, $subtitle ) = @_;
1760 my $dbh = C4::Context->dbh;
1761 &REALnewsubtitle( $dbh, $bibnum, $subtitle );
1764 =head2 $errors = newitems($item, @barcodes);
1768 insert items ($item is a hash)
1776 my ( $item, @barcodes ) = @_;
1777 my $dbh = C4::Context->dbh;
1781 foreach my $barcode (@barcodes) {
1782 # add items, one by one for each barcode.
1784 $oneitem->{barcode}= $barcode;
1785 my $MARCitem = &MARCkoha2marcItem( $dbh, $oneitem);
1786 $oneitem->{marc} = $MARCitem->as_usmarc;
1787 ( $itemnumber, $error ) = &REALnewitems( $dbh, $oneitem);
1788 # $errors .= $error;
1789 # &MARCadditem( $dbh, $MARCitem, $item->{biblionumber} );
1794 =head2 moditem($item);
1798 modify an item ($item is a hash with all item informations)
1807 my $dbh = C4::Context->dbh;
1808 &REALmoditem( $dbh, $item );
1810 &MARCkoha2marcItem( $dbh, $item->{'biblionumber'}, $item->{'itemnum'} );
1812 &MARCfind_MARCbibid_from_oldbiblionumber( $dbh, $item->{biblionumber} );
1813 &MARCmoditem( $dbh, $MARCitem, $bibid, $item->{itemnum}, 0 );
1816 =head2 $error = checkitems($count,@barcodes);
1820 check for each @barcode entry that the barcode is not a duplicate
1827 my ( $count, @barcodes ) = @_;
1828 my $dbh = C4::Context->dbh;
1830 my $sth = $dbh->prepare("Select * from items where barcode=?");
1831 for ( my $i = 0 ; $i < $count ; $i++ ) {
1832 $barcodes[$i] = uc $barcodes[$i];
1833 $sth->execute( $barcodes[$i] );
1834 if ( my $data = $sth->fetchrow_hashref ) {
1835 $error .= " Duplicate Barcode: $barcodes[$i]";
1842 =head2 $delitem($itemnum);
1846 delete item $itemnum being the item number to delete
1854 my $dbh = C4::Context->dbh;
1855 &REALdelitem( $dbh, $itemnum );
1858 =head2 deletebiblioitem($biblioitemnumber);
1862 delete the biblioitem $biblioitemnumber
1868 sub deletebiblioitem {
1869 my ($biblioitemnumber) = @_;
1870 my $dbh = C4::Context->dbh;
1871 &REALdelbiblioitem( $dbh, $biblioitemnumber );
1872 } # sub deletebiblioitem
1874 =head2 delbiblio($biblionumber)
1878 delete biblio $biblionumber
1886 my $dbh = C4::Context->dbh;
1887 &REALdelbiblio( $dbh, $biblio );
1888 my $bibid = &MARCfind_MARCbibid_from_oldbiblionumber( $dbh, $biblio );
1889 &MARCdelbiblio( $dbh, $bibid, 0 );
1892 =head2 ($count,@results) = getbiblio($biblionumber);
1896 return an array with hash of biblios.
1898 FIXME : biblionumber being the primary key, this sub will always return only 1 result, API should be modified...
1905 my ($biblionumber) = @_;
1906 my $dbh = C4::Context->dbh;
1907 my $sth = $dbh->prepare("Select * from biblio where biblionumber = ?");
1909 # || die "Cannot prepare $query\n" . $dbh->errstr;
1913 $sth->execute($biblionumber);
1915 # || die "Cannot execute $query\n" . $sth->errstr;
1916 while ( my $data = $sth->fetchrow_hashref ) {
1917 $results[$count] = $data;
1922 return ( $count, @results );
1927 $data = &bibdata($biblionumber, $type);
1929 Returns information about the book with the given biblionumber.
1931 C<$type> is ignored.
1933 C<&bibdata> returns a reference-to-hash. The keys are the fields in
1934 the C<biblio>, C<biblioitems>, and C<bibliosubtitle> tables in the
1937 In addition, C<$data-E<gt>{subject}> is the list of the book's
1938 subjects, separated by C<" , "> (space, comma, space).
1940 If there are multiple biblioitems with the given biblionumber, only
1941 the first one is considered.
1946 my ($bibnum, $type) = @_;
1947 my $dbh = C4::Context->dbh;
1948 my $sth = $dbh->prepare("Select *, biblioitems.notes AS bnotes, biblio.notes
1950 left join biblioitems on biblioitems.biblionumber = biblio.biblionumber
1951 left join bibliosubtitle on
1952 biblio.biblionumber = bibliosubtitle.biblionumber
1953 left join itemtypes on biblioitems.itemtype=itemtypes.itemtype
1954 where biblio.biblionumber = ?
1956 $sth->execute($bibnum);
1958 $data = $sth->fetchrow_hashref;
1960 # handle management of repeated subtitle
1961 $sth = $dbh->prepare("Select * from bibliosubtitle where biblionumber = ?");
1962 $sth->execute($bibnum);
1964 while (my $dat = $sth->fetchrow_hashref){
1966 $line{subtitle} = $dat->{subtitle};
1967 push @subtitles, \%line;
1969 $data->{subtitles} = \@subtitles;
1971 $sth = $dbh->prepare("Select * from bibliosubject where biblionumber = ?");
1972 $sth->execute($bibnum);
1974 while (my $dat = $sth->fetchrow_hashref){
1976 $line{subject} = $dat->{'subject'};
1977 push @subjects, \%line;
1979 $data->{subjects} = \@subjects;
1981 $sth = $dbh->prepare("Select * from additionalauthors where biblionumber = ?");
1982 $sth->execute($bibnum);
1983 while (my $dat = $sth->fetchrow_hashref){
1984 $data->{'additionalauthors'} .= "$dat->{'author'} - ";
1986 chop $data->{'additionalauthors'};
1987 chop $data->{'additionalauthors'};
1988 chop $data->{'additionalauthors'};
1993 =head2 ($count,@results) = getbiblioitem($biblioitemnumber);
1997 return an array with hash of biblioitemss.
1999 FIXME : biblioitemnumber being unique, this sub will always return only 1 result, API should be modified...
2006 my ($biblioitemnum) = @_;
2007 my $dbh = C4::Context->dbh;
2008 my $sth = $dbh->prepare( "Select * from biblioitems where
2009 biblioitemnumber = ?"
2014 $sth->execute($biblioitemnum);
2016 while ( my $data = $sth->fetchrow_hashref ) {
2017 $results[$count] = $data;
2022 return ( $count, @results );
2023 } # sub getbiblioitem
2025 =head2 ($count,@results) = getbiblioitembybiblionumber($biblionumber);
2029 return an array with hash of biblioitems for the given biblionumber.
2035 sub getbiblioitembybiblionumber {
2036 my ($biblionumber) = @_;
2037 my $dbh = C4::Context->dbh;
2038 my $sth = $dbh->prepare("Select * from biblioitems where biblionumber = ?");
2042 $sth->execute($biblionumber);
2044 while ( my $data = $sth->fetchrow_hashref ) {
2045 $results[$count] = $data;
2050 return ( $count, @results );
2053 =head2 ($count,@results) = getitemsbybiblioitem($biblionumber);
2057 returns an array with hash of items
2063 sub getitemsbybiblioitem {
2064 my ($biblioitemnum) = @_;
2065 my $dbh = C4::Context->dbh;
2066 my $sth = $dbh->prepare( "Select * from items, biblio where
2067 biblio.biblionumber = items.biblionumber and biblioitemnumber
2071 # || die "Cannot prepare $query\n" . $dbh->errstr;
2075 $sth->execute($biblioitemnum);
2077 # || die "Cannot execute $query\n" . $sth->errstr;
2078 while ( my $data = $sth->fetchrow_hashref ) {
2079 $results[$count] = $data;
2084 return ( $count, @results );
2085 } # sub getitemsbybiblioitem
2089 @results = &ItemInfo($env, $biblionumber, $type);
2091 Returns information about books with the given biblionumber.
2093 C<$type> may be either C<intra> or anything else. If it is not set to
2094 C<intra>, then the search will exclude lost, very overdue, and
2099 C<&ItemInfo> returns a list of references-to-hash. Each element
2100 contains a number of keys. Most of them are table items from the
2101 C<biblio>, C<biblioitems>, C<items>, and C<itemtypes> tables in the
2102 Koha database. Other keys include:
2106 =item C<$data-E<gt>{branchname}>
2108 The name (not the code) of the branch to which the book belongs.
2110 =item C<$data-E<gt>{datelastseen}>
2112 This is simply C<items.datelastseen>, except that while the date is
2113 stored in YYYY-MM-DD format in the database, here it is converted to
2114 DD/MM/YYYY format. A NULL date is returned as C<//>.
2116 =item C<$data-E<gt>{datedue}>
2118 =item C<$data-E<gt>{class}>
2120 This is the concatenation of C<biblioitems.classification>, the book's
2121 Dewey code, and C<biblioitems.subclass>.
2123 =item C<$data-E<gt>{ocount}>
2125 I think this is the number of copies of the book available.
2127 =item C<$data-E<gt>{order}>
2129 If this is set, it is set to C<One Order>.
2136 my ($env,$biblionumber,$type) = @_;
2137 my $dbh = C4::Context->dbh;
2138 my $query = "SELECT *,items.notforloan as itemnotforloan FROM items, biblio, biblioitems
2139 left join itemtypes on biblioitems.itemtype = itemtypes.itemtype
2140 WHERE items.biblionumber = ?
2141 AND biblioitems.biblioitemnumber = items.biblioitemnumber
2142 AND biblio.biblionumber = items.biblionumber";
2143 $query .= " order by items.dateaccessioned desc";
2144 my $sth=$dbh->prepare($query);
2145 $sth->execute($biblionumber);
2148 while (my $data=$sth->fetchrow_hashref){
2150 my $isth=$dbh->prepare("Select issues.*,borrowers.cardnumber from issues,borrowers where itemnumber = ? and returndate is null and issues.borrowernumber=borrowers.borrowernumber");
2151 $isth->execute($data->{'itemnumber'});
2152 if (my $idata=$isth->fetchrow_hashref){
2153 $data->{borrowernumber} = $idata->{borrowernumber};
2154 $data->{cardnumber} = $idata->{cardnumber};
2155 $datedue = format_date($idata->{'date_due'});
2157 if ($datedue eq ''){
2158 my ($restype,$reserves)=C4::Reserves2::CheckReserves($data->{'itemnumber'});
2164 #get branch information.....
2165 my $bsth=$dbh->prepare("SELECT * FROM branches WHERE branchcode = ?");
2166 $bsth->execute($data->{'holdingbranch'});
2167 if (my $bdata=$bsth->fetchrow_hashref){
2168 $data->{'branchname'} = $bdata->{'branchname'};
2170 my $date=format_date($data->{'datelastseen'});
2171 $data->{'datelastseen'}=$date;
2172 $data->{'datedue'}=$datedue;
2173 # get notforloan complete status if applicable
2174 my $sthnflstatus = $dbh->prepare('select authorised_value from marc_subfield_structure where kohafield="items.notforloan"');
2175 $sthnflstatus->execute;
2176 my ($authorised_valuecode) = $sthnflstatus->fetchrow;
2177 if ($authorised_valuecode) {
2178 $sthnflstatus = $dbh->prepare("select lib from authorised_values where category=? and authorised_value=?");
2179 $sthnflstatus->execute($authorised_valuecode,$data->{itemnotforloan});
2180 my ($lib) = $sthnflstatus->fetchrow;
2181 $data->{notforloan} = $lib;
2192 ($count, @results) = &bibitems($biblionumber);
2194 Given the biblionumber for a book, C<&bibitems> looks up that book's
2195 biblioitems (different publications of the same book, the audio book
2196 and film versions, etc.).
2198 C<$count> is the number of elements in C<@results>.
2200 C<@results> is an array of references-to-hash; the keys are the fields
2201 of the C<biblioitems> and C<itemtypes> tables of the Koha database. In
2202 addition, C<itemlost> indicates the availability of the item: if it is
2203 "2", then all copies of the item are long overdue; if it is "1", then
2204 all copies are lost; otherwise, there is at least one copy available.
2210 my $dbh = C4::Context->dbh;
2211 my $sth = $dbh->prepare("SELECT biblioitems.*,
2213 MIN(items.itemlost) as itemlost,
2214 MIN(items.dateaccessioned) as dateaccessioned
2215 FROM biblioitems, itemtypes, items
2216 WHERE biblioitems.biblionumber = ?
2217 AND biblioitems.itemtype = itemtypes.itemtype
2218 AND biblioitems.biblioitemnumber = items.biblioitemnumber
2219 GROUP BY items.biblioitemnumber");
2222 $sth->execute($bibnum);
2223 while (my $data = $sth->fetchrow_hashref) {
2224 $results[$count] = $data;
2228 return($count, @results);
2234 $itemdata = &bibitemdata($biblioitemnumber);
2236 Looks up the biblioitem with the given biblioitemnumber. Returns a
2237 reference-to-hash. The keys are the fields from the C<biblio>,
2238 C<biblioitems>, and C<itemtypes> tables in the Koha database, except
2239 that C<biblioitems.notes> is given as C<$itemdata-E<gt>{bnotes}>.
2245 my $dbh = C4::Context->dbh;
2246 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");
2249 $sth->execute($bibitem);
2251 $data = $sth->fetchrow_hashref;
2258 =item getbibliofromitemnumber
2260 $item = &getbibliofromitemnumber($env, $dbh, $itemnumber);
2262 Looks up the item with the given itemnumber.
2264 C<$env> and C<$dbh> are ignored.
2266 C<&itemnodata> returns a reference-to-hash whose keys are the fields
2267 from the C<biblio>, C<biblioitems>, and C<items> tables in the Koha
2272 sub getbibliofromitemnumber {
2273 my ($env,$dbh,$itemnumber) = @_;
2274 $dbh = C4::Context->dbh;
2275 my $sth=$dbh->prepare("Select * from biblio,items,biblioitems
2276 where items.itemnumber = ?
2277 and biblio.biblionumber = items.biblionumber
2278 and biblioitems.biblioitemnumber = items.biblioitemnumber");
2280 $sth->execute($itemnumber);
2281 my $data=$sth->fetchrow_hashref;
2288 @barcodes = &barcodes($biblioitemnumber);
2290 Given a biblioitemnumber, looks up the corresponding items.
2292 Returns an array of references-to-hash; the keys are C<barcode> and
2295 The returned items include very overdue items, but not lost ones.
2300 #called from request.pl
2301 my ($biblioitemnumber)=@_;
2302 my $dbh = C4::Context->dbh;
2303 my $sth=$dbh->prepare("SELECT barcode, itemlost, holdingbranch FROM items
2304 WHERE biblioitemnumber = ?
2305 AND (wthdrawn <> 1 OR wthdrawn IS NULL)");
2306 $sth->execute($biblioitemnumber);
2309 while (my $data=$sth->fetchrow_hashref){
2310 $barcodes[$i]=$data;
2320 $item = &itemdata($barcode);
2322 Looks up the item with the given barcode, and returns a
2323 reference-to-hash containing information about that item. The keys of
2324 the hash are the fields from the C<items> and C<biblioitems> tables in
2329 sub get_item_from_barcode {
2331 my $dbh = C4::Context->dbh;
2332 my $sth=$dbh->prepare("Select * from items,biblioitems where barcode=?
2333 and items.biblioitemnumber=biblioitems.biblioitemnumber");
2334 $sth->execute($barcode);
2335 my $data=$sth->fetchrow_hashref;
2343 @issues = &itemissues($biblioitemnumber, $biblio);
2345 Looks up information about who has borrowed the bookZ<>(s) with the
2346 given biblioitemnumber.
2348 C<$biblio> is ignored.
2350 C<&itemissues> returns an array of references-to-hash. The keys
2351 include the fields from the C<items> table in the Koha database.
2352 Additional keys include:
2358 If the item is currently on loan, this gives the due date.
2360 If the item is not on loan, then this is either "Available" or
2361 "Cancelled", if the item has been withdrawn.
2365 If the item is currently on loan, this gives the card number of the
2366 patron who currently has the item.
2368 =item C<timestamp0>, C<timestamp1>, C<timestamp2>
2370 These give the timestamp for the last three times the item was
2373 =item C<card0>, C<card1>, C<card2>
2375 The card number of the last three patrons who borrowed this item.
2377 =item C<borrower0>, C<borrower1>, C<borrower2>
2379 The borrower number of the last three patrons who borrowed this item.
2386 my ($bibitem, $biblio)=@_;
2387 my $dbh = C4::Context->dbh;
2388 # FIXME - If this function die()s, the script will abort, and the
2389 # user won't get anything; depending on how far the script has
2390 # gotten, the user might get a blank page. It would be much better
2391 # to at least print an error message. The easiest way to do this
2392 # is to set $SIG{__DIE__}.
2393 my $sth = $dbh->prepare("Select * from items where
2394 items.biblioitemnumber = ?")
2395 || die $dbh->errstr;
2399 $sth->execute($bibitem)
2400 || die $sth->errstr;
2402 while (my $data = $sth->fetchrow_hashref) {
2403 # Find out who currently has this item.
2404 # FIXME - Wouldn't it be better to do this as a left join of
2405 # some sort? Currently, this code assumes that if
2406 # fetchrow_hashref() fails, then the book is on the shelf.
2407 # fetchrow_hashref() can fail for any number of reasons (e.g.,
2408 # database server crash), not just because no items match the
2410 my $sth2 = $dbh->prepare("select * from issues,borrowers
2411 where itemnumber = ?
2412 and returndate is NULL
2413 and issues.borrowernumber = borrowers.borrowernumber");
2415 $sth2->execute($data->{'itemnumber'});
2416 if (my $data2 = $sth2->fetchrow_hashref) {
2417 $data->{'date_due'} = $data2->{'date_due'};
2418 $data->{'card'} = $data2->{'cardnumber'};
2419 $data->{'borrower'} = $data2->{'borrowernumber'};
2421 if ($data->{'wthdrawn'} eq '1') {
2422 $data->{'date_due'} = 'Cancelled';
2424 $data->{'date_due'} = 'Available';
2430 # Find the last 3 people who borrowed this item.
2431 $sth2 = $dbh->prepare("select * from issues, borrowers
2432 where itemnumber = ?
2433 and issues.borrowernumber = borrowers.borrowernumber
2434 and returndate is not NULL
2435 order by returndate desc,timestamp desc") || die $dbh->errstr;
2436 $sth2->execute($data->{'itemnumber'}) || die $sth2->errstr;
2437 for (my $i2 = 0; $i2 < 2; $i2++) { # FIXME : error if there is less than 3 pple borrowing this item
2438 if (my $data2 = $sth2->fetchrow_hashref) {
2439 $data->{"timestamp$i2"} = $data2->{'timestamp'};
2440 $data->{"card$i2"} = $data2->{'cardnumber'};
2441 $data->{"borrower$i2"} = $data2->{'borrowernumber'};
2446 $results[$i] = $data;
2456 ($count, $subjects) = &getsubject($biblionumber);
2458 Looks up the subjects of the book with the given biblionumber. Returns
2459 a two-element list. C<$subjects> is a reference-to-array, where each
2460 element is a subject of the book, and C<$count> is the number of
2461 elements in C<$subjects>.
2467 my $dbh = C4::Context->dbh;
2468 my $sth=$dbh->prepare("Select * from bibliosubject where biblionumber=?");
2469 $sth->execute($bibnum);
2472 while (my $data=$sth->fetchrow_hashref){
2477 return($i,\@results);
2482 ($count, $authors) = &getaddauthor($biblionumber);
2484 Looks up the additional authors for the book with the given
2487 Returns a two-element list. C<$authors> is a reference-to-array, where
2488 each element is an additional author, and C<$count> is the number of
2489 elements in C<$authors>.
2495 my $dbh = C4::Context->dbh;
2496 my $sth=$dbh->prepare("Select * from additionalauthors where biblionumber=?");
2497 $sth->execute($bibnum);
2500 while (my $data=$sth->fetchrow_hashref){
2505 return($i,\@results);
2511 ($count, $subtitles) = &getsubtitle($biblionumber);
2513 Looks up the subtitles for the book with the given biblionumber.
2515 Returns a two-element list. C<$subtitles> is a reference-to-array,
2516 where each element is a subtitle, and C<$count> is the number of
2517 elements in C<$subtitles>.
2523 my $dbh = C4::Context->dbh;
2524 my $sth=$dbh->prepare("Select * from bibliosubtitle where biblionumber=?");
2525 $sth->execute($bibnum);
2528 while (my $data=$sth->fetchrow_hashref){
2533 return($i,\@results);
2539 ($count, @websites) = &getwebsites($biblionumber);
2541 Looks up the web sites pertaining to the book with the given
2544 C<$count> is the number of elements in C<@websites>.
2546 C<@websites> is an array of references-to-hash; the keys are the
2547 fields from the C<websites> table in the Koha database.
2550 #FIXME : could maybe be deleted. Otherwise, would be better in a Websites.pm package
2551 #(with add / modify / delete subs)
2554 my ($biblionumber) = @_;
2555 my $dbh = C4::Context->dbh;
2556 my $sth = $dbh->prepare("Select * from websites where biblionumber = ?");
2560 $sth->execute($biblionumber);
2561 while (my $data = $sth->fetchrow_hashref) {
2562 # FIXME - The URL scheme shouldn't be stripped off, at least
2563 # not here, since it's part of the URL, and will be useful in
2564 # constructing a link to the site. If you don't want the user
2565 # to see the "http://" part, strip that off when building the
2567 $data->{'url'} =~ s/^http:\/\///; # FIXME - Leaning toothpick
2569 $results[$count] = $data;
2574 return($count, @results);
2577 =item getwebbiblioitems
2579 ($count, @results) = &getwebbiblioitems($biblionumber);
2581 Given a book's biblionumber, looks up the web versions of the book
2582 (biblioitems with itemtype C<WEB>).
2584 C<$count> is the number of items in C<@results>. C<@results> is an
2585 array of references-to-hash; the keys are the items from the
2586 C<biblioitems> table of the Koha database.
2590 sub getwebbiblioitems {
2591 my ($biblionumber) = @_;
2592 my $dbh = C4::Context->dbh;
2593 my $sth = $dbh->prepare("Select * from biblioitems where biblionumber = ?
2594 and itemtype = 'WEB'");
2598 $sth->execute($biblionumber);
2599 while (my $data = $sth->fetchrow_hashref) {
2600 $data->{'url'} =~ s/^http:\/\///;
2601 $results[$count] = $data;
2606 return($count, @results);
2607 } # sub getwebbiblioitems
2611 # converts ISO 5426 coded string to ISO 8859-1
2612 # sloppy code : should be improved in next issue
2613 my ( $string, $encoding ) = @_;
2616 # $encoding = C4::Context->preference("marcflavour") unless $encoding;
2617 if ( $encoding eq "UNIMARC" ) {
2686 # this handles non-sorting blocks (if implementation requires this)
2687 $string = nsb_clean($_);
2689 elsif ( $encoding eq "USMARC" || $encoding eq "MARC21" ) {
2690 if (/[\xc1-\xff]/) {
2743 # this handles non-sorting blocks (if implementation requires this)
2744 $string = nsb_clean($_);
2751 my $NSB = '\x88'; # NSB : begin Non Sorting Block
2752 my $NSE = '\x89'; # NSE : Non Sorting Block end
2753 # handles non sorting blocks
2757 s/[ ]{0,1}$NSE/) /gm;
2764 my $dbh = C4::Context->dbh;
2765 my $result = MARCmarc2koha($dbh,$record,'');
2767 my ($biblionumber,$bibid,$title);
2768 # search duplicate on ISBN, easy and fast...
2769 if ($result->{isbn}) {
2770 $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=?");
2771 $sth->execute($result->{'isbn'});
2772 ($biblionumber,$bibid,$title) = $sth->fetchrow;
2773 return $biblionumber,$bibid,$title if ($biblionumber);
2775 # a more complex search : build a request for SearchMarc::catalogsearch()
2776 my (@tags, @and_or, @excluding, @operator, @value, $offset,$length);
2777 # search on biblio.title
2778 my ($tag,$subfield) = MARCfind_marc_from_kohafield($dbh,"biblio.title","");
2779 if ($record->field($tag)) {
2780 if ($record->field($tag)->subfields($subfield)) {
2781 push @tags, "'".$tag.$subfield."'";
2782 push @and_or, "and";
2783 push @excluding, "";
2784 push @operator, "contains";
2785 push @value, $record->field($tag)->subfield($subfield);
2786 # warn "for title, I add $tag / $subfield".$record->field($tag)->subfield($subfield);
2789 # ... and on biblio.author
2790 ($tag,$subfield) = MARCfind_marc_from_kohafield($dbh,"biblio.author","");
2791 if ($record->field($tag)) {
2792 if ($record->field($tag)->subfields($subfield)) {
2793 push @tags, "'".$tag.$subfield."'";
2794 push @and_or, "and";
2795 push @excluding, "";
2796 push @operator, "contains";
2797 push @value, $record->field($tag)->subfield($subfield);
2798 # warn "for author, I add $tag / $subfield".$record->field($tag)->subfield($subfield);
2801 # ... and on publicationyear.
2802 ($tag,$subfield) = MARCfind_marc_from_kohafield($dbh,"biblioitems.publicationyear","");
2803 if ($record->field($tag)) {
2804 if ($record->field($tag)->subfields($subfield)) {
2805 push @tags, "'".$tag.$subfield."'";
2806 push @and_or, "and";
2807 push @excluding, "";
2808 push @operator, "=";
2809 push @value, $record->field($tag)->subfield($subfield);
2810 # warn "for publicationyear, I add $tag / $subfield".$record->field($tag)->subfield($subfield);
2814 ($tag,$subfield) = MARCfind_marc_from_kohafield($dbh,"biblioitems.size","");
2815 if ($record->field($tag)) {
2816 if ($record->field($tag)->subfields($subfield)) {
2817 push @tags, "'".$tag.$subfield."'";
2818 push @and_or, "and";
2819 push @excluding, "";
2820 push @operator, "=";
2821 push @value, $record->field($tag)->subfield($subfield);
2822 # warn "for size, I add $tag / $subfield".$record->field($tag)->subfield($subfield);
2825 # ... and on publisher.
2826 ($tag,$subfield) = MARCfind_marc_from_kohafield($dbh,"biblioitems.publishercode","");
2827 if ($record->field($tag)) {
2828 if ($record->field($tag)->subfields($subfield)) {
2829 push @tags, "'".$tag.$subfield."'";
2830 push @and_or, "and";
2831 push @excluding, "";
2832 push @operator, "=";
2833 push @value, $record->field($tag)->subfield($subfield);
2834 # warn "for publishercode, I add $tag / $subfield".$record->field($tag)->subfield($subfield);
2837 # ... and on volume.
2838 ($tag,$subfield) = MARCfind_marc_from_kohafield($dbh,"biblioitems.volume","");
2839 if ($record->field($tag)) {
2840 if ($record->field($tag)->subfields($subfield)) {
2841 push @tags, "'".$tag.$subfield."'";
2842 push @and_or, "and";
2843 push @excluding, "";
2844 push @operator, "=";
2845 push @value, $record->field($tag)->subfield($subfield);
2846 # warn "for volume, I add $tag / $subfield".$record->field($tag)->subfield($subfield);
2850 my ($finalresult,$nbresult) = C4::SearchMarc::catalogsearch($dbh,\@tags,\@and_or,\@excluding,\@operator,\@value,0,10);
2851 # there is at least 1 result => return the 1st one
2853 # warn "$nbresult => ".@$finalresult[0]->{biblionumber},@$finalresult[0]->{bibid},@$finalresult[0]->{title};
2854 return @$finalresult[0]->{biblionumber},@$finalresult[0]->{bibid},@$finalresult[0]->{title};
2856 # no result, returns nothing
2863 if(substr($isbn, 0, 1) <=7) {
2864 $seg1 = substr($isbn, 0, 1);
2865 } elsif(substr($isbn, 0, 2) <= 94) {
2866 $seg1 = substr($isbn, 0, 2);
2867 } elsif(substr($isbn, 0, 3) <= 995) {
2868 $seg1 = substr($isbn, 0, 3);
2869 } elsif(substr($isbn, 0, 4) <= 9989) {
2870 $seg1 = substr($isbn, 0, 4);
2872 $seg1 = substr($isbn, 0, 5);
2874 my $x = substr($isbn, length($seg1));
2876 if(substr($x, 0, 2) <= 19) {
2877 # if(sTmp2 < 10) sTmp2 = "0" sTmp2;
2878 $seg2 = substr($x, 0, 2);
2879 } elsif(substr($x, 0, 3) <= 699) {
2880 $seg2 = substr($x, 0, 3);
2881 } elsif(substr($x, 0, 4) <= 8399) {
2882 $seg2 = substr($x, 0, 4);
2883 } elsif(substr($x, 0, 5) <= 89999) {
2884 $seg2 = substr($x, 0, 5);
2885 } elsif(substr($x, 0, 6) <= 9499999) {
2886 $seg2 = substr($x, 0, 6);
2888 $seg2 = substr($x, 0, 7);
2890 my $seg3=substr($x,length($seg2));
2891 $seg3=substr($seg3,0,length($seg3)-1) ;
2892 my $seg4 = substr($x, -1, 1);
2893 return "$seg1-$seg2-$seg3-$seg4";
2897 END { } # module clean-up code here (global destructor)
2903 Koha Developement team <info@koha.org>
2905 Paul POULAIN paul.poulain@free.fr
2911 # Revision 1.137 2006/02/13 16:34:26 tipaul
2912 # fixing some warnings (perl -w should be quiet)
2914 # Revision 1.136 2006/01/10 17:01:29 tipaul
2915 # adding a XMLgetbiblio in Biblio.pm (1st draft, to use with zebra)
2917 # Revision 1.135 2006/01/06 16:39:37 tipaul
2918 # synch'ing head and rel_2_2 (from 2.2.5, including npl templates)
2919 # Seems not to break too many things, but i'm probably wrong here.
2920 # at least, new features/bugfixes from 2.2.5 are here (tested on some features on my head local copy)
2922 # - removing useless directories (koha-html and koha-plucene)
2924 # Revision 1.134 2006/01/04 15:54:55 tipaul
2925 # utf8 is a : go for beta test in HEAD.
2926 # some explanations :
2927 # - 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.
2928 # - *-top.inc will show the pages in utf8
2929 # - 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.
2930 # - using marcxml field and no more the iso2709 raw marc biblioitems.marc field.
2932 # Revision 1.133 2005/12/12 14:25:51 thd
2935 # Reverse array filled with elements from repeated subfields
2936 # to avoid last to first concatenation of elements in Koha DB.-
2938 # Revision 1.132 2005-10-26 09:12:33 tipaul
2939 # big commit, still breaking things...
2941 # * synch with rel_2_2. Probably the last non manual synch, as rel_2_2 should not be modified deeply.
2942 # * code cleaning (cleaning warnings from perl -w) continued
2944 # Revision 1.131 2005/09/22 10:01:45 tipaul
2945 # see mail on koha-devel : code cleaning on Search.pm + normalizing API + use of biblionumber everywhere (instead of bn, biblio, ...)
2947 # Revision 1.130 2005/09/02 14:34:14 tipaul
2948 # continuing the work to move to zebra. Begin of work for MARC=OFF support.
2949 # IMPORTANT NOTE : the MARCkoha2marc sub API has been modified. Instead of biblionumber & biblioitemnumber, it now gets a hash.
2950 # The sub is used only in Biblio.pm, so the API change should be harmless (except for me, but i'm aware ;-) )
2952 # Revision 1.129 2005/08/12 13:50:31 tipaul
2953 # removing useless sub declarations
2955 # Revision 1.128 2005/08/11 16:12:47 tipaul
2956 # Playing with the zebra...
2958 # * go to koha cvs home directory
2959 # * in misc/zebra there is a unimarc directory. I suggest that marc21 libraries create a marc21 directory
2960 # * put your zebra.cfg files here & create your database.
2961 # * from koha cvs home directory, ln -s misc/zebra/marc21 zebra (I mean create a symbolic link to YOUR zebra directory)
2962 # * now, everytime you add/modify a biblio/item your zebra DB is updated correctly.
2965 # * this uses a system call in perl. CPU consumming, but we are waiting for indexdata Perl/zoom
2966 # * deletion still not work
2967 # * UNIMARC zebra config files are provided in misc/zebra/unimarc directory. The most important line being :
2969 # recordId: (bib1,Local-number)
2973 # elm 090 Local-number -
2974 # elm 090/? Local-number -
2975 # elm 090/?/9 Local-number !:w
2977 # (090$9 being the field mapped to biblio.biblionumber in Koha)
2979 # Revision 1.127 2005/08/11 14:37:32 tipaul
2981 # * removing useless subs
2982 # * removing some subs that are also elsewhere
2983 # * 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)
2985 # Revision 1.126 2005/08/11 09:13:28 tipaul
2986 # just removing useless subs (a lot !!!) for code cleaning
2988 # Revision 1.125 2005/08/11 09:00:07 tipaul
2989 # Ok guys, this time, it seems that item add and modif begin working as expected...
2990 # Still a lot of bugs to fix, of course
2992 # Revision 1.124 2005/08/10 10:21:15 tipaul
2993 # continuing the road to zebra :
2994 # - the biblio add begins to work.
2995 # - the biblio modif begins to work.
2997 # (still without doing anything on zebra)
2998 # (no new change in updatedatabase)
3000 # Revision 1.123 2005/08/09 14:10:28 tipaul
3001 # 1st commit to go to zebra.
3002 # don't update your cvs if you want to have a working head...
3004 # this commit contains :
3005 # * 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...
3006 # * 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.
3007 # * other files : get rid of bibid and use biblionumber instead.
3010 # * does not do anything on zebra yet.
3011 # * if you rename marc_subfield_table, you can't search anymore.
3012 # * you can view a biblio & bibliodetails, go to MARC editor, but NOT save any modif.
3013 # * 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 ;-) )
3015 # 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
3016 # 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.
3018 # tipaul cutted previous commit notes