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;
30 use vars qw($VERSION @ISA @EXPORT);
32 # set the version for version checking
38 # don't forget MARCxxx subs are exported only for testing purposes. Should not be used
39 # as the old-style API and the NEW one are the only public functions.
42 &newbiblio &newbiblioitem
43 &newsubject &newsubtitle &newitems
45 &modbiblio &checkitems &modbibitem
46 &modsubtitle &modsubject &modaddauthor &moditem
48 &delitem &deletebiblioitem &delbiblio
50 &getbiblio &bibdata &bibitems &bibitemdata
51 &barcodes &ItemInfo &itemdata &itemissues &itemcount
52 &getsubject &getaddauthor &getsubtitle
53 &getwebbiblioitems &getwebsites
54 &getbiblioitembybiblionumber
55 &getbiblioitem &getitemsbybiblioitem
57 &MARCfind_marc_from_kohafield
58 &MARCfind_frameworkcode
59 &find_biblioitemnumber
62 &NEWnewbiblio &NEWnewitem
63 &NEWmodbiblio &NEWmoditem
64 &NEWdelbiblio &NEWdelitem
65 &NEWmodbiblioframework
67 &MARCkoha2marcBiblio &MARCmarc2koha
68 &MARCkoha2marcItem &MARChtml2marc
69 &MARCgetbiblio &MARCgetitem
77 MARCfind_MARCbibid_from_oldbiblionumber
82 C4::Biblio - acquisition, catalog management functions
86 ( lot of changes for Koha 3.0)
88 Koha 1.2 and previous version used a specific API to manage biblios. This API uses old-DB style parameters.
89 They are based on a hash, and store data in biblio/biblioitems/items tables (plus additionalauthors, bibliosubject and bibliosubtitle where applicable)
91 In Koha 2.0, we introduced a MARC-DB.
93 In Koha 3.0 we removed this MARC-DB for search as we wanted to use Zebra as search system.
95 So in Koha 3.0, saving a record means :
96 - storing the raw marc record (iso2709) in biblioitems.marc field. It contains both biblio & items informations.
97 - storing the "decoded information" in biblio/biblioitems/items as previously.
98 - using zebra to manage search & indexing on the MARC datas.
100 In Koha, there is a systempreference saying "MARC=ON" or "MARC=OFF"
102 * MARC=ON : when MARC=ON, koha uses a MARC::Record object (in sub parameters). Saving informations in the DB means :
103 - transform the MARC record into a hash
104 - add the raw marc record into the hash
105 - store them & update zebra
107 * MARC=OFF : when MARC=OFF, koha uses a hash object (in sub parameters). Saving informations in the DB means :
108 - transform the hash into a MARC record
109 - add the raw marc record into the hash
110 - store them and update zebra
113 That's why we need 3 types of subs :
117 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
119 =head2 NEWxxx related subs
123 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.
125 all subs requires/use $dbh as 1st parameter and a MARC::Record object as 2nd parameter. they sometimes requires another parameter.
129 =head2 something_elsexxx related subs
133 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.
135 all subs requires/use $dbh as 1st parameter and a hash as 2nd parameter.
144 my ($biblionumber,$record) = @_;
145 # create the iso2709 file for zebra
146 # my $cgidir = C4::Context->intranetdir ."/cgi-bin";
147 # unless (opendir(DIR, "$cgidir")) {
148 # $cgidir = C4::Context->intranetdir."/";
151 # my $filename = $cgidir."/zebra/biblios/BIBLIO".$biblionumber."iso2709";
152 # open F,"> $filename";
153 # print F $record->as_usmarc();
155 # my $res = system("cd $cgidir/zebra;/usr/local/bin/zebraidx update biblios");
159 # warn "zebra_create : $biblionumber =".$record->as_formatted;
161 $xmlrecord=$record->as_xml();
164 warn "ERROR badly formatted marc record";
165 warn "Skipping record";
169 $Zconn = new ZOOM::Connection(C4::Context->config("zebradb"));
172 warn "Error ", $@->code(), ": ", $@->message(), "\n";
173 die "Fatal error, cant connect to z3950 server";
176 $Zconn->option(cqlfile => C4::Context->config("intranetdir")."/zebra/pqf.properties");
177 my $Zpackage = $Zconn->package();
178 $Zpackage->option(action => "specialUpdate");
179 $Zpackage->option(record => $xmlrecord);
180 $Zpackage->send("update");
187 z3950_extended_services can handle any interaction with Zebra's extended serices package.
189 $Zconn contains the server connection object (which is set before calling this s
192 $service type is one of:
193 itemorder,create,drop,commit,update,xmlupdate
195 $service_options is a hash of key/value pairs. For instance,
196 if service_type is 'update', $service_options should contain:
198 action => update action, one of specialUpdate, recordInsert, recordReplace, recordDelete, elementUpdate.
199 (recordidOpaque => Opaque Record ID (user supplied)
203 recordidNumber => Record ID number (system number))
204 record => the record itself
208 syntax => the record syntax (transfer syntax)
209 databaseName = Database from connection object
212 sub z3950_extended_services {
214 my ($Zconn,$serviceType,$serviceOptions,$record);
216 # create a new package object
217 my $Zpackage = $Zconn->package();
220 $Zpackage->option(action => $serviceOptions->{'action'});
222 if ($serviceOptions->{'databaseName'}) {
223 $Zpackage->option(databaseName => $serviceOptions->{'databaseName'});
225 if ($serviceOptions->{'recordIdNumber'}) {
226 $Zpackage->option(recordIdNumber => $serviceOptions->{'recordIdNumber'});
228 if ($serviceOptions->{'recordIdOpaque'}) {
229 $Zpackage->option(recordIdOpaque => $serviceOptions->{'recordIdOpaque'});
232 # this is an ILL request (Zebra doesn't support it)
233 if ($serviceType eq 'itemorder') {
234 $Zpackage->option('contact-name' => $serviceOptions->{'contact-name'});
235 $Zpackage->option('contact-phone' => $serviceOptions->{'contact-phone'});
236 $Zpackage->option('contact-email' => $serviceOptions->{'contact-email'});
237 $Zpackage->option('itemorder-item' => $serviceOptions->{'itemorder-item'});
241 $Zpackage->option(record => $record);
242 if ($serviceOptions->{'syntax'}) {
243 $Zpackage->option(syntax => $serviceOptions->{'syntax'});
247 # send the request, handle any exception encountered
248 eval { $Zpackage->send($serviceType) };
249 if ($@ && $@->isa("ZOOM::Exception")) {
250 print "Oops! ", $@->message(), "\n";
253 # free up package resources
254 $Zpackage->destroy();
257 =head2 @tagslib = &MARCgettagslib($dbh,1|0,$frameworkcode);
261 2nd param is 1 for liblibrarian and 0 for libopac
262 $frameworkcode contains the framework reference. If empty or does not exist, the default one is used
264 returns a hash with all values for all fields and subfields for a given MARC framework :
265 $res->{$tag}->{lib} = ($forlibrarian or !$libopac)?$liblibrarian:$libopac;
267 ->{mandatory} = $mandatory;
268 ->{repeatable} = $repeatable;
269 ->{$subfield}->{lib} = ($forlibrarian or !$libopac)?$liblibrarian:$libopac;
271 ->{mandatory} = $mandatory;
272 ->{repeatable} = $repeatable;
273 ->{authorised_value} = $authorised_value;
274 ->{authtypecode} = $authtypecode;
275 ->{value_builder} = $value_builder;
276 ->{kohafield} = $kohafield;
277 ->{seealso} = $seealso;
278 ->{hidden} = $hidden;
287 my ( $dbh, $forlibrarian, $frameworkcode ) = @_;
288 $frameworkcode = "" unless $frameworkcode;
289 $forlibrarian = 1 unless $forlibrarian;
291 my $libfield = ( $forlibrarian eq 1 ) ? 'liblibrarian' : 'libopac';
293 # check that framework exists
296 "select count(*) from marc_tag_structure where frameworkcode=?");
297 $sth->execute($frameworkcode);
298 my ($total) = $sth->fetchrow;
299 $frameworkcode = "" unless ( $total > 0 );
302 "select tagfield,liblibrarian,libopac,mandatory,repeatable from marc_tag_structure where frameworkcode=? order by tagfield"
304 $sth->execute($frameworkcode);
305 my ( $liblibrarian, $libopac, $tag, $res, $tab, $mandatory, $repeatable );
307 while ( ( $tag, $liblibrarian, $libopac, $mandatory, $repeatable ) = $sth->fetchrow ) {
308 $res->{$tag}->{lib} = ($forlibrarian or !$libopac)?$liblibrarian:$libopac;
309 $res->{$tag}->{tab} = ""; # XXX
310 $res->{$tag}->{mandatory} = $mandatory;
311 $res->{$tag}->{repeatable} = $repeatable;
316 "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"
318 $sth->execute($frameworkcode);
321 my $authorised_value;
331 ( $tag, $subfield, $liblibrarian, , $libopac, $tab,
332 $mandatory, $repeatable, $authorised_value, $authtypecode,
333 $value_builder, $kohafield, $seealso, $hidden,
338 $res->{$tag}->{$subfield}->{lib} = ($forlibrarian or !$libopac)?$liblibrarian:$libopac;
339 $res->{$tag}->{$subfield}->{tab} = $tab;
340 $res->{$tag}->{$subfield}->{mandatory} = $mandatory;
341 $res->{$tag}->{$subfield}->{repeatable} = $repeatable;
342 $res->{$tag}->{$subfield}->{authorised_value} = $authorised_value;
343 $res->{$tag}->{$subfield}->{authtypecode} = $authtypecode;
344 $res->{$tag}->{$subfield}->{value_builder} = $value_builder;
345 $res->{$tag}->{$subfield}->{kohafield} = $kohafield;
346 $res->{$tag}->{$subfield}->{seealso} = $seealso;
347 $res->{$tag}->{$subfield}->{hidden} = $hidden;
348 $res->{$tag}->{$subfield}->{isurl} = $isurl;
349 $res->{$tag}->{$subfield}->{link} = $link;
354 =head2 ($tagfield,$tagsubfield) = &MARCfind_marc_from_kohafield($dbh,$kohafield);
358 finds MARC tag and subfield for a given kohafield
359 kohafield is "table.field" where table= biblio|biblioitems|items, and field a field of the previous table
365 sub MARCfind_marc_from_kohafield {
366 my ( $dbh, $kohafield,$frameworkcode ) = @_;
367 return 0, 0 unless $kohafield;
368 $frameworkcode='' unless $frameworkcode;
369 my $relations = C4::Context->marcfromkohafield;
370 return ($relations->{$frameworkcode}->{$kohafield}->[0],$relations->{$frameworkcode}->{$kohafield}->[1]);
373 =head2 $MARCRecord = &MARCgetbiblio($dbh,$biblionumber);
377 Returns a MARC::Record for the biblio $biblionumber.
383 # Returns MARC::Record of the biblio passed in parameter.
384 my ( $dbh, $biblionumber ) = @_;
385 my $sth = $dbh->prepare('select marc from biblioitems where biblionumber=?');
386 $sth->execute($biblionumber);
387 my ($marc) = $sth->fetchrow;
388 my $record = MARC::Record::new_from_usmarc($marc);
392 =head2 $XML = &XMLgetbiblio($dbh,$biblionumber);
396 Returns a raw XML for the biblio $biblionumber.
402 # Returns MARC::Record of the biblio passed in parameter.
403 my ( $dbh, $biblionumber ) = @_;
404 my $sth = $dbh->prepare('select marcxml,marc from biblioitems where biblionumber=?');
405 $sth->execute($biblionumber);
406 my ($XML,$marc) = $sth->fetchrow;
407 # my $record =MARC::Record::new_from_usmarc($marc);
408 # warn "MARC : \n*-************************\n".$record->as_xml."\n*-************************\n";
412 =head2 $MARCrecord = &MARCgetitem($dbh,$biblionumber);
416 Returns a MARC::Record with all items of biblio # $biblionumber
424 my ( $dbh, $biblionumber, $itemnumber ) = @_;
425 my $frameworkcode=MARCfind_frameworkcode($dbh,$biblionumber);
426 # get the complete MARC record
427 my $sth = $dbh->prepare("select marc from biblioitems where biblionumber=?");
428 $sth->execute($biblionumber);
429 my ($rawmarc) = $sth->fetchrow;
430 my $record = MARC::File::USMARC::decode($rawmarc);
431 # now, find the relevant itemnumber
432 my ($itemnumberfield,$itemnumbersubfield) = MARCfind_marc_from_kohafield($dbh,'items.itemnumber',$frameworkcode);
433 # prepare the new item record
434 my $itemrecord = MARC::Record->new();
435 # parse all fields fields from the complete record
436 foreach ($record->field($itemnumberfield)) {
437 # when the item field is found, save it
438 if ($_->subfield($itemnumbersubfield) == $itemnumber) {
439 $itemrecord->append_fields($_);
446 =head2 sub find_biblioitemnumber($dbh,$biblionumber);
450 Returns the 1st biblioitemnumber related to $biblionumber. When MARC=ON we should have 1 biblionumber = 1 and only 1 biblioitemnumber
451 This sub is useless when MARC=OFF
456 sub find_biblioitemnumber {
457 my ( $dbh, $biblionumber ) = @_;
458 my $sth = $dbh->prepare("select biblioitemnumber from biblioitems where biblionumber=?");
459 $sth->execute($biblionumber);
460 my ($biblioitemnumber) = $sth->fetchrow;
461 return $biblioitemnumber;
464 =head2 $frameworkcode = MARCfind_frameworkcode($dbh,$biblionumber);
468 returns the framework of a given biblio
474 sub MARCfind_frameworkcode {
475 my ( $dbh, $biblionumber ) = @_;
476 my $sth = $dbh->prepare("select frameworkcode from biblio where biblionumber=?");
477 $sth->execute($biblionumber);
478 my ($frameworkcode) = $sth->fetchrow;
479 return $frameworkcode;
482 =head2 $MARCRecord = &MARCkoha2marcBiblio($dbh,$bibliohash);
486 MARCkoha2marcBiblio is a wrapper between old-DB and MARC-DB. It returns a MARC::Record builded with old-DB biblio/biblioitem :
487 all entries of the hash are transformed into their matching MARC field/subfield.
493 sub MARCkoha2marcBiblio {
495 # this function builds partial MARC::Record from the old koha-DB fields
496 my ( $dbh, $bibliohash ) = @_;
497 # we don't have biblio entries in the hash, so we add them first
498 my $sth = $dbh->prepare("select * from biblio where biblionumber=?");
499 $sth->execute($bibliohash->{biblionumber});
500 my $biblio = $sth->fetchrow_hashref;
501 foreach (keys %$biblio) {
502 $bibliohash->{$_}=$biblio->{$_};
504 $sth = $dbh->prepare("select tagfield,tagsubfield from marc_subfield_structure where frameworkcode=? and kohafield=?");
505 my $record = MARC::Record->new();
506 foreach ( keys %$bibliohash ) {
507 &MARCkoha2marcOnefield( $sth, $record, "biblio." . $_, $bibliohash->{$_}, '') if $bibliohash->{$_};
508 &MARCkoha2marcOnefield( $sth, $record, "biblioitems." . $_, $bibliohash->{$_}, '') if $bibliohash->{$_};
511 # other fields => additional authors, subjects, subtitles
512 my $sth2 = $dbh->prepare(" SELECT author FROM additionalauthors WHERE biblionumber=?");
513 $sth2->execute($bibliohash->{biblionumber});
514 while ( my $row = $sth2->fetchrow_hashref ) {
515 &MARCkoha2marcOnefield( $sth, $record, "additionalauthors.author", $bibliohash->{'author'},'' );
517 $sth2 = $dbh->prepare(" SELECT subject FROM bibliosubject WHERE biblionumber=?");
518 $sth2->execute($bibliohash->{biblionumber});
519 while ( my $row = $sth2->fetchrow_hashref ) {
520 &MARCkoha2marcOnefield( $sth, $record, "bibliosubject.subject", $row->{'subject'},'' );
522 $sth2 = $dbh->prepare(" SELECT subtitle FROM bibliosubtitle WHERE biblionumber=?");
523 $sth2->execute($bibliohash->{biblionumber});
524 while ( my $row = $sth2->fetchrow_hashref ) {
525 &MARCkoha2marcOnefield( $sth, $record, "bibliosubtitle.subtitle", $row->{'subtitle'},'' );
531 =head2 $MARCRecord = &MARCkoha2marcItem($dbh,$biblionumber,itemnumber);
533 MARCkoha2marcItem is a wrapper between old-DB and MARC-DB. It returns a MARC::Record builded with old-DB items :
534 all entries of the hash are transformed into their matching MARC field/subfield.
542 sub MARCkoha2marcItem {
544 # this function builds partial MARC::Record from the old koha-DB fields
545 my ( $dbh, $item ) = @_;
547 # my $dbh=&C4Connect;
548 my $sth = $dbh->prepare("select tagfield,tagsubfield from marc_subfield_structure where frameworkcode=? and kohafield=?");
549 my $record = MARC::Record->new();
551 foreach( keys %$item ) {
553 &MARCkoha2marcOnefield( $sth, $record, "items." . $_,
560 =head2 MARCkoha2marcOnefield
564 This sub is for internal use only, used by koha2marcBiblio & koha2marcItem
570 sub MARCkoha2marcOnefield {
571 my ( $sth, $record, $kohafieldname, $value,$frameworkcode ) = @_;
574 $sth->execute($frameworkcode,$kohafieldname);
575 if ( ( $tagfield, $tagsubfield ) = $sth->fetchrow ) {
576 if ( $record->field($tagfield) ) {
577 my $tag = $record->field($tagfield);
579 $tag->add_subfields( $tagsubfield, $value );
580 $record->delete_field($tag);
581 $record->add_fields($tag);
585 $record->add_fields( $tagfield, " ", " ", $tagsubfield => $value );
591 =head2 $MARCrecord = MARChtml2marc($dbh,$rtags,$rsubfields,$rvalues,%indicators);
595 transforms the parameters (coming from HTML form) into a MARC::Record
596 parameters with r are references to arrays.
598 FIXME : should be improved for 3.0, to avoid having 4 differents arrays
605 my ($dbh,$rtags,$rsubfields,$rvalues,%indicators) = @_;
607 my $record = MARC::Record->new();
608 # my %subfieldlist=();
609 my $prevvalue; # if tag <10
610 my $field; # if tag >=10
611 for (my $i=0; $i< @$rtags; $i++) {
612 next unless @$rvalues[$i];
613 # rebuild MARC::Record
614 # warn "0=>".@$rtags[$i].@$rsubfields[$i]." = ".@$rvalues[$i].": ";
615 if (@$rtags[$i] ne $prevtag) {
618 if ($prevtag ne '000') {
619 $record->add_fields((sprintf "%03s",$prevtag),$prevvalue);
621 $record->leader($prevvalue);
626 $record->add_fields($field);
629 $indicators{@$rtags[$i]}.=' ';
630 if (@$rtags[$i] <10) {
631 $prevvalue= @$rvalues[$i];
635 $field = MARC::Field->new( (sprintf "%03s",@$rtags[$i]), substr($indicators{@$rtags[$i]},0,1),substr($indicators{@$rtags[$i]},1,1), @$rsubfields[$i] => @$rvalues[$i]);
636 # warn "1=>".@$rtags[$i].@$rsubfields[$i]." = ".@$rvalues[$i].": ".$field->as_formatted;
638 $prevtag = @$rtags[$i];
640 if (@$rtags[$i] <10) {
641 $prevvalue=@$rvalues[$i];
643 if (length(@$rvalues[$i])>0) {
644 $field->add_subfields(@$rsubfields[$i] => @$rvalues[$i]);
645 # warn "2=>".@$rtags[$i].@$rsubfields[$i]." = ".@$rvalues[$i].": ".$field->as_formatted;
648 $prevtag= @$rtags[$i];
651 # the last has not been included inside the loop... do it now !
652 $record->add_fields($field) if $field;
653 # warn "HTML2MARC=".$record->as_formatted;
658 =head2 $hash = &MARCmarc2koha($dbh,$MARCRecord);
662 builds a hash with old-db datas from a MARC::Record
669 my ($dbh,$record,$frameworkcode) = @_;
670 my $sth=$dbh->prepare("select tagfield,tagsubfield from marc_subfield_structure where frameworkcode=? and kohafield=?");
672 my $sth2=$dbh->prepare("SHOW COLUMNS from biblio");
675 while (($field)=$sth2->fetchrow) {
676 # warn "biblio.".$field;
677 $result=&MARCmarc2kohaOneField($sth,"biblio",$field,$record,$result,$frameworkcode);
679 $sth2=$dbh->prepare("SHOW COLUMNS from biblioitems");
681 while (($field)=$sth2->fetchrow) {
682 if ($field eq 'notes') { $field = 'bnotes'; }
683 # warn "biblioitems".$field;
684 $result=&MARCmarc2kohaOneField($sth,"biblioitems",$field,$record,$result,$frameworkcode);
686 $sth2=$dbh->prepare("SHOW COLUMNS from items");
688 while (($field)=$sth2->fetchrow) {
689 # warn "items".$field;
690 $result=&MARCmarc2kohaOneField($sth,"items",$field,$record,$result,$frameworkcode);
692 # additional authors : specific
693 $result = &MARCmarc2kohaOneField($sth,"bibliosubtitle","subtitle",$record,$result,$frameworkcode);
694 $result = &MARCmarc2kohaOneField($sth,"additionalauthors","additionalauthors",$record,$result,$frameworkcode);
695 # modify copyrightdate to keep only the 1st year found
696 my $temp = $result->{'copyrightdate'};
698 $temp =~ m/c(\d\d\d\d)/; # search cYYYY first
700 $result->{'copyrightdate'} = $1;
701 } else { # if no cYYYY, get the 1st date.
702 $temp =~ m/(\d\d\d\d)/;
703 $result->{'copyrightdate'} = $1;
706 # modify publicationyear to keep only the 1st year found
707 $temp = $result->{'publicationyear'};
708 $temp =~ m/c(\d\d\d\d)/; # search cYYYY first
710 $result->{'publicationyear'} = $1;
711 } else { # if no cYYYY, get the 1st date.
712 $temp =~ m/(\d\d\d\d)/;
713 $result->{'publicationyear'} = $1;
718 sub MARCmarc2kohaOneField {
720 # FIXME ? if a field has a repeatable subfield that is used in old-db, only the 1st will be retrieved...
721 my ( $sth, $kohatable, $kohafield, $record, $result,$frameworkcode ) = @_;
722 # warn "kohatable / $kohafield / $result / ";
726 ( $tagfield, $subfield ) = MARCfind_marc_from_kohafield("",$kohatable.".".$kohafield,$frameworkcode);
727 foreach my $field ( $record->field($tagfield) ) {
728 if ($field->tag()<10) {
729 if ($result->{$kohafield}) {
730 # Reverse array filled with elements from repeated subfields
731 # from first to last to avoid last to first concatenation of
732 # elements in Koha DB. -- thd.
733 $result->{$kohafield} .= " | ".reverse($field->data());
735 $result->{$kohafield} = $field->data();
738 if ( $field->subfields ) {
739 my @subfields = $field->subfields();
740 foreach my $subfieldcount ( 0 .. $#subfields ) {
741 if ($subfields[$subfieldcount][0] eq $subfield) {
742 if ( $result->{$kohafield} ) {
743 $result->{$kohafield} .= " | " . $subfields[$subfieldcount][1];
746 $result->{$kohafield} = $subfields[$subfieldcount][1];
753 # warn "OneField for $kohatable.$kohafield and $frameworkcode=> $tagfield, $subfield";
757 =head2 ($biblionumber,$biblioitemnumber) = NEWnewbibilio($dbh,$MARCRecord,$frameworkcode);
761 creates a biblio from a MARC::Record.
768 my ( $dbh, $record, $frameworkcode ) = @_;
770 my $biblioitemnumber;
771 my $olddata = MARCmarc2koha( $dbh, $record,$frameworkcode );
772 $olddata->{frameworkcode} = $frameworkcode;
773 $biblionumber = REALnewbiblio( $dbh, $olddata );
774 $olddata->{biblionumber} = $biblionumber;
775 # add biblionumber into the MARC record (it's the ID for zebra)
776 my ( $tagfield, $tagsubfield ) =
777 MARCfind_marc_from_kohafield( $dbh, "biblio.biblionumber",$frameworkcode );
781 $newfield = MARC::Field->new(
782 $tagfield, $biblionumber,
785 $newfield = MARC::Field->new(
786 $tagfield, '', '', "$tagsubfield" => $biblionumber,
789 # drop old field (just in case it already exist and create new one...
790 my $old_field = $record->field($tagfield);
791 $record->delete_field($old_field);
792 $record->add_fields($newfield);
794 #create the marc entry, that stores the rax marc record in Koha 3.0
795 $olddata->{marc} = $record->as_usmarc();
796 $olddata->{marcxml} = $record->as_xml();
797 # and create biblioitem, that's all folks !
798 $biblioitemnumber = REALnewbiblioitem( $dbh, $olddata );
800 # search subtiles, addiauthors and subjects
801 ( $tagfield, $tagsubfield ) =
802 MARCfind_marc_from_kohafield( $dbh, "additionalauthors.author",$frameworkcode );
803 my @addiauthfields = $record->field($tagfield);
804 foreach my $addiauthfield (@addiauthfields) {
805 my @addiauthsubfields = $addiauthfield->subfield($tagsubfield);
806 foreach my $subfieldcount ( 0 .. $#addiauthsubfields ) {
807 REALmodaddauthor( $dbh, $biblionumber,
808 $addiauthsubfields[$subfieldcount] );
811 ( $tagfield, $tagsubfield ) =
812 MARCfind_marc_from_kohafield( $dbh, "bibliosubtitle.subtitle",$frameworkcode );
813 my @subtitlefields = $record->field($tagfield);
814 foreach my $subtitlefield (@subtitlefields) {
815 my @subtitlesubfields = $subtitlefield->subfield($tagsubfield);
816 foreach my $subfieldcount ( 0 .. $#subtitlesubfields ) {
817 REALnewsubtitle( $dbh, $biblionumber,
818 $subtitlesubfields[$subfieldcount] );
821 ( $tagfield, $tagsubfield ) =
822 MARCfind_marc_from_kohafield( $dbh, "bibliosubject.subject",$frameworkcode );
823 my @subj = $record->field($tagfield);
825 foreach my $subject (@subj) {
826 my @subjsubfield = $subject->subfield($tagsubfield);
827 foreach my $subfieldcount ( 0 .. $#subjsubfield ) {
828 push @subjects, $subjsubfield[$subfieldcount];
831 REALmodsubject( $dbh, $biblionumber, 1, @subjects );
832 return ( $biblionumber, $biblioitemnumber );
835 =head2 NEWmodbilbioframework($dbh,$biblionumber,$frameworkcode);
839 modify the framework of a biblio
845 sub NEWmodbiblioframework {
846 my ($dbh,$biblionumber,$frameworkcode) =@_;
847 my $sth = $dbh->prepare("Update biblio SET frameworkcode=? WHERE biblionumber=?");
848 $sth->execute($frameworkcode,$biblionumber);
852 =head2 NEWmodbiblio($dbh,$MARCrecord,$biblionumber,$frameworkcode);
856 modify a biblio (MARC=ON)
863 my ($dbh,$record,$biblionumber,$frameworkcode) =@_;
864 $frameworkcode="" unless $frameworkcode;
865 # &MARCmodbiblio($dbh,$bibid,$record,$frameworkcode,0);
866 my $oldbiblio = MARCmarc2koha($dbh,$record,$frameworkcode);
868 $oldbiblio->{frameworkcode} = $frameworkcode;
869 #create the marc entry, that stores the rax marc record in Koha 3.0
870 $oldbiblio->{biblionumber} = $biblionumber unless $oldbiblio->{biblionumber};
871 $oldbiblio->{marc} = $record->as_usmarc();
872 $oldbiblio->{marcxml} = $record->as_xml();
873 warn "dans NEWmodbiblio $biblionumber = ".$oldbiblio->{biblionumber}." = ".$oldbiblio->{marcxml};
874 REALmodbiblio($dbh,$oldbiblio);
875 REALmodbiblioitem($dbh,$oldbiblio);
876 # now, modify addi authors, subject, addititles.
877 my ($tagfield,$tagsubfield) = MARCfind_marc_from_kohafield($dbh,"additionalauthors.author",$frameworkcode);
878 my @addiauthfields = $record->field($tagfield);
879 foreach my $addiauthfield (@addiauthfields) {
880 my @addiauthsubfields = $addiauthfield->subfield($tagsubfield);
881 $dbh->do("delete from additionalauthors where biblionumber=$biblionumber");
882 foreach my $subfieldcount (0..$#addiauthsubfields) {
883 REALmodaddauthor($dbh,$biblionumber,$addiauthsubfields[$subfieldcount]);
886 ($tagfield,$tagsubfield) = MARCfind_marc_from_kohafield($dbh,"bibliosubtitle.subtitle",$frameworkcode);
887 my @subtitlefields = $record->field($tagfield);
888 foreach my $subtitlefield (@subtitlefields) {
889 my @subtitlesubfields = $subtitlefield->subfield($tagsubfield);
890 # delete & create subtitle again because REALmodsubtitle can't handle new subtitles
892 $dbh->do("delete from bibliosubtitle where biblionumber=$biblionumber");
893 foreach my $subfieldcount (0..$#subtitlesubfields) {
894 foreach my $subtit(split /\||#/,$subtitlesubfields[$subfieldcount]) {
895 REALnewsubtitle($dbh,$biblionumber,$subtit);
899 ($tagfield,$tagsubfield) = MARCfind_marc_from_kohafield($dbh,"bibliosubject.subject",$frameworkcode);
900 my @subj = $record->field($tagfield);
902 foreach my $subject (@subj) {
903 my @subjsubfield = $subject->subfield($tagsubfield);
904 foreach my $subfieldcount (0..$#subjsubfield) {
905 push @subjects,$subjsubfield[$subfieldcount];
908 REALmodsubject($dbh,$biblionumber,1,@subjects);
912 =head2 NEWmodbilbioframework($dbh,$biblionumber,$frameworkcode);
923 my ( $dbh, $bibid ) = @_;
924 my $biblio = &MARCfind_oldbiblionumber_from_MARCbibid( $dbh, $bibid );
925 &REALdelbiblio( $dbh, $biblio );
928 "select biblioitemnumber from biblioitems where biblionumber=?");
929 $sth->execute($biblio);
930 while ( my ($biblioitemnumber) = $sth->fetchrow ) {
931 REALdelbiblioitem( $dbh, $biblioitemnumber );
933 &MARCdelbiblio( $dbh, $bibid, 0 );
936 =head2 $itemnumber = NEWnewitem($dbh, $record, $biblionumber, $biblioitemnumber);
940 creates an item from a MARC::Record
947 my ( $dbh, $record, $biblionumber, $biblioitemnumber ) = @_;
950 my $frameworkcode=MARCfind_frameworkcode($dbh,$biblionumber);
951 my $item = &MARCmarc2koha( $dbh, $record,$frameworkcode );
952 # needs old biblionumber and biblioitemnumber
953 $item->{'biblionumber'} = $biblionumber;
954 $item->{'biblioitemnumber'}=$biblioitemnumber;
955 $item->{marc} = $record->as_usmarc();
957 my ( $itemnumber, $error ) = &REALnewitems( $dbh, $item, $item->{barcode} );
962 =head2 $itemnumber = NEWmoditem($dbh, $record, $biblionumber, $biblioitemnumber,$itemnumber);
973 my ( $dbh, $record, $biblionumber, $biblioitemnumber, $itemnumber) = @_;
975 my $frameworkcode=MARCfind_frameworkcode($dbh,$biblionumber);
976 my $olditem = MARCmarc2koha( $dbh, $record,$frameworkcode );
978 $olditem->{marc} = $record->as_usmarc();
979 $olditem->{biblionumber} = $biblionumber;
980 $olditem->{biblioitemnumber} = $biblioitemnumber;
982 REALmoditem( $dbh, $olditem );
986 =head2 $itemnumber = NEWdelitem($dbh, $biblionumber, $biblioitemnumber, $itemnumber);
997 my ( $dbh, $bibid, $itemnumber ) = @_;
998 my $biblio = &MARCfind_oldbiblionumber_from_MARCbibid( $dbh, $bibid );
999 &REALdelitem( $dbh, $itemnumber );
1000 &MARCdelitem( $dbh, $bibid, $itemnumber );
1004 =head2 $biblionumber = REALnewbiblio($dbh,$biblio);
1008 adds a record in biblio table. Datas are in the hash $biblio.
1015 my ( $dbh, $biblio ) = @_;
1017 $dbh->do('lock tables biblio WRITE');
1018 my $sth = $dbh->prepare("Select max(biblionumber) from biblio");
1020 my $data = $sth->fetchrow_arrayref;
1021 my $bibnum = $$data[0] + 1;
1024 if ( $biblio->{'seriestitle'} ) { $series = 1 }
1027 $dbh->prepare("insert into biblio set biblionumber=?, title=?, author=?, copyrightdate=?,
1028 serial=?, seriestitle=?, notes=?, abstract=?,
1032 $bibnum, $biblio->{'title'},
1033 $biblio->{'author'}, $biblio->{'copyrightdate'},
1034 $biblio->{'serial'}, $biblio->{'seriestitle'},
1035 $biblio->{'notes'}, $biblio->{'abstract'},
1036 $biblio->{'unititle'}
1040 $dbh->do('unlock tables');
1044 =head2 $biblionumber = REALmodbiblio($dbh,$biblio);
1048 modify a record in biblio table. Datas are in the hash $biblio.
1055 my ( $dbh, $biblio ) = @_;
1056 my $sth = $dbh->prepare("Update biblio set title=?, author=?, abstract=?, copyrightdate=?,
1057 seriestitle=?, serial=?, unititle=?, notes=?, frameworkcode=?
1058 where biblionumber = ?"
1061 $biblio->{'title'}, $biblio->{'author'},
1062 $biblio->{'abstract'}, $biblio->{'copyrightdate'},
1063 $biblio->{'seriestitle'}, $biblio->{'serial'},
1064 $biblio->{'unititle'}, $biblio->{'notes'},
1065 $biblio->{frameworkcode},
1066 $biblio->{'biblionumber'}
1069 return ( $biblio->{'biblionumber'} );
1072 =head2 REALmodsubtitle($dbh,$bibnum,$subtitle);
1076 modify subtitles in bibliosubtitle table.
1082 sub REALmodsubtitle {
1083 my ( $dbh, $bibnum, $subtitle ) = @_;
1086 "update bibliosubtitle set subtitle = ? where biblionumber = ?");
1087 $sth->execute( $subtitle, $bibnum );
1091 =head2 REALmodaddauthor($dbh,$bibnum,$author);
1095 adds or modify additional authors
1096 NOTE : Strange sub : seems to delete MANY and add only ONE author... maybe buggy ?
1102 sub REALmodaddauthor {
1103 my ( $dbh, $bibnum, @authors ) = @_;
1105 # my $dbh = C4Connect;
1107 $dbh->prepare("Delete from additionalauthors where biblionumber = ?");
1109 $sth->execute($bibnum);
1111 foreach my $author (@authors) {
1112 if ( $author ne '' ) {
1115 "Insert into additionalauthors set author = ?, biblionumber = ?"
1118 $sth->execute( $author, $bibnum );
1123 } # sub modaddauthor
1125 =head2 $errors = REALmodsubject($dbh,$bibnum, $force, @subject);
1129 modify/adds subjects
1134 sub REALmodsubject {
1135 my ( $dbh, $bibnum, $force, @subject ) = @_;
1137 # my $dbh = C4Connect;
1138 my $count = @subject;
1140 for ( my $i = 0 ; $i < $count ; $i++ ) {
1141 $subject[$i] =~ s/^ //g;
1142 $subject[$i] =~ s/ $//g;
1145 "select * from catalogueentry where entrytype = 's' and catalogueentry = ?"
1147 $sth->execute( $subject[$i] );
1149 if ( my $data = $sth->fetchrow_hashref ) {
1152 if ( $force eq $subject[$i] || $force == 1 ) {
1154 # subject not in aut, chosen to force anway
1155 # so insert into cataloguentry so its in auth file
1158 "Insert into catalogueentry (entrytype,catalogueentry) values ('s',?)"
1161 $sth2->execute( $subject[$i] ) if ( $subject[$i] );
1166 "$subject[$i]\n does not exist in the subject authority file";
1169 "Select * from catalogueentry where entrytype = 's' and (catalogueentry like ? or catalogueentry like ? or catalogueentry like ?)"
1171 $sth2->execute( "$subject[$i] %", "% $subject[$i] %",
1173 while ( my $data = $sth2->fetchrow_hashref ) {
1174 $error .= "<br>$data->{'catalogueentry'}";
1183 $dbh->prepare("Delete from bibliosubject where biblionumber = ?");
1184 $sth->execute($bibnum);
1188 "Insert into bibliosubject (subject,biblionumber) values (?,?)");
1190 foreach $query (@subject) {
1191 $sth->execute( $query, $bibnum ) if ( $query && $bibnum );
1200 =head2 REALmodbiblioitem($dbh, $biblioitem);
1209 sub REALmodbiblioitem {
1210 my ( $dbh, $biblioitem ) = @_;
1213 my $sth = $dbh->prepare("update biblioitems set number=?,volume=?, volumedate=?, lccn=?,
1214 itemtype=?, url=?, isbn=?, issn=?,
1215 publishercode=?, publicationyear=?, classification=?, dewey=?,
1216 subclass=?, illus=?, pages=?, volumeddesc=?,
1217 notes=?, size=?, place=?, marc=?,
1219 where biblioitemnumber=?");
1220 $sth->execute( $biblioitem->{number}, $biblioitem->{volume}, $biblioitem->{volumedate}, $biblioitem->{lccn},
1221 $biblioitem->{itemtype}, $biblioitem->{url}, $biblioitem->{isbn}, $biblioitem->{issn},
1222 $biblioitem->{publishercode}, $biblioitem->{publicationyear}, $biblioitem->{classification}, $biblioitem->{dewey},
1223 $biblioitem->{subclass}, $biblioitem->{illus}, $biblioitem->{pages}, $biblioitem->{volumeddesc},
1224 $biblioitem->{bnotes}, $biblioitem->{size}, $biblioitem->{place}, $biblioitem->{marc},
1225 $biblioitem->{marcxml}, $biblioitem->{biblioitemnumber});
1226 my $record = MARC::File::USMARC::decode($biblioitem->{marc});
1227 zebra_create($biblioitem->{biblionumber}, $record);
1228 # warn "MOD : $biblioitem->{biblioitemnumber} = ".$biblioitem->{marc};
1231 =head2 REALnewbiblioitem($dbh,$biblioitem);
1235 adds a biblioitem ($biblioitem is a hash with the values)
1241 sub REALnewbiblioitem {
1242 my ( $dbh, $biblioitem ) = @_;
1244 $dbh->do("lock tables biblioitems WRITE, biblio WRITE, marc_subfield_structure READ");
1245 my $sth = $dbh->prepare("Select max(biblioitemnumber) from biblioitems");
1247 my $biblioitemnumber;
1250 $data = $sth->fetchrow_arrayref;
1251 $biblioitemnumber = $$data[0] + 1;
1253 # Insert biblioitemnumber in MARC record, we need it to manage items later...
1254 my $frameworkcode=MARCfind_frameworkcode($dbh,$biblioitem->{biblionumber});
1255 my ($biblioitemnumberfield,$biblioitemnumbersubfield) = MARCfind_marc_from_kohafield($dbh,'biblioitems.biblioitemnumber',$frameworkcode);
1256 my $record = MARC::File::USMARC::decode($biblioitem->{marc});
1257 my $field=$record->field($biblioitemnumberfield);
1258 $field->update($biblioitemnumbersubfield => "$biblioitemnumber");
1259 $biblioitem->{marc} = $record->as_usmarc();
1260 $biblioitem->{marcxml} = $record->as_xml();
1262 $sth = $dbh->prepare( "insert into biblioitems set
1263 biblioitemnumber = ?, biblionumber = ?,
1264 volume = ?, number = ?,
1265 classification = ?, itemtype = ?,
1267 issn = ?, dewey = ?,
1268 subclass = ?, publicationyear = ?,
1269 publishercode = ?, volumedate = ?,
1270 volumeddesc = ?, illus = ?,
1271 pages = ?, notes = ?,
1273 marc = ?, place = ?,
1277 $biblioitemnumber, $biblioitem->{'biblionumber'},
1278 $biblioitem->{'volume'}, $biblioitem->{'number'},
1279 $biblioitem->{'classification'}, $biblioitem->{'itemtype'},
1280 $biblioitem->{'url'}, $biblioitem->{'isbn'},
1281 $biblioitem->{'issn'}, $biblioitem->{'dewey'},
1282 $biblioitem->{'subclass'}, $biblioitem->{'publicationyear'},
1283 $biblioitem->{'publishercode'}, $biblioitem->{'volumedate'},
1284 $biblioitem->{'volumeddesc'}, $biblioitem->{'illus'},
1285 $biblioitem->{'pages'}, $biblioitem->{'bnotes'},
1286 $biblioitem->{'size'}, $biblioitem->{'lccn'},
1287 $biblioitem->{'marc'}, $biblioitem->{'place'},
1288 $biblioitem->{marcxml},
1290 $dbh->do("unlock tables");
1291 zebra_create($biblioitem->{biblionumber}, $record);
1292 return ($biblioitemnumber);
1295 =head2 REALnewsubtitle($dbh,$bibnum,$subtitle);
1299 create a new subtitle
1304 sub REALnewsubtitle {
1305 my ( $dbh, $bibnum, $subtitle ) = @_;
1308 "insert into bibliosubtitle set biblionumber = ?, subtitle = ?");
1309 $sth->execute( $bibnum, $subtitle ) if $subtitle;
1313 =head2 ($itemnumber,$errors)= REALnewitems($dbh,$item,$barcode);
1317 create a item. $item is a hash and $barcode the barcode.
1324 my ( $dbh, $item, $barcode ) = @_;
1326 # warn "OLDNEWITEMS";
1328 $dbh->do('lock tables items WRITE, biblio WRITE,biblioitems WRITE,marc_subfield_structure WRITE');
1329 my $sth = $dbh->prepare("Select max(itemnumber) from items");
1334 $data = $sth->fetchrow_hashref;
1335 $itemnumber = $data->{'max(itemnumber)'} + 1;
1337 # FIXME the "notforloan" field seems to be named "loan" in some places. workaround bugfix.
1338 if ( $item->{'loan'} ) {
1339 $item->{'notforloan'} = $item->{'loan'};
1342 # if dateaccessioned is provided, use it. Otherwise, set to NOW()
1343 if ( $item->{'dateaccessioned'} ) {
1344 $sth = $dbh->prepare( "Insert into items set
1345 itemnumber = ?, biblionumber = ?,
1346 multivolumepart = ?,
1347 biblioitemnumber = ?, barcode = ?,
1348 booksellerid = ?, dateaccessioned = ?,
1349 homebranch = ?, holdingbranch = ?,
1350 price = ?, replacementprice = ?,
1351 replacementpricedate = NOW(), datelastseen = NOW(),
1352 multivolume = ?, stack = ?,
1353 itemlost = ?, wthdrawn = ?,
1354 paidfor = ?, itemnotes = ?,
1355 itemcallnumber =?, notforloan = ?,
1360 $itemnumber, $item->{'biblionumber'},
1361 $item->{'multivolumepart'},
1362 $item->{'biblioitemnumber'},$item->{barcode},
1363 $item->{'booksellerid'}, $item->{'dateaccessioned'},
1364 $item->{'homebranch'}, $item->{'holdingbranch'},
1365 $item->{'price'}, $item->{'replacementprice'},
1366 $item->{multivolume}, $item->{stack},
1367 $item->{itemlost}, $item->{wthdrawn},
1368 $item->{paidfor}, $item->{'itemnotes'},
1369 $item->{'itemcallnumber'}, $item->{'notforloan'},
1372 if ( defined $sth->errstr ) {
1373 $error .= $sth->errstr;
1377 $sth = $dbh->prepare( "Insert into items set
1378 itemnumber = ?, biblionumber = ?,
1379 multivolumepart = ?,
1380 biblioitemnumber = ?, barcode = ?,
1381 booksellerid = ?, dateaccessioned = NOW(),
1382 homebranch = ?, holdingbranch = ?,
1383 price = ?, replacementprice = ?,
1384 replacementpricedate = NOW(), datelastseen = NOW(),
1385 multivolume = ?, stack = ?,
1386 itemlost = ?, wthdrawn = ?,
1387 paidfor = ?, itemnotes = ?,
1388 itemcallnumber =?, notforloan = ?,
1393 $itemnumber, $item->{'biblionumber'},
1394 $item->{'multivolumepart'},
1395 $item->{'biblioitemnumber'},$item->{barcode},
1396 $item->{'booksellerid'},
1397 $item->{'homebranch'}, $item->{'holdingbranch'},
1398 $item->{'price'}, $item->{'replacementprice'},
1399 $item->{multivolume}, $item->{stack},
1400 $item->{itemlost}, $item->{wthdrawn},
1401 $item->{paidfor}, $item->{'itemnotes'},
1402 $item->{'itemcallnumber'}, $item->{'notforloan'},
1405 if ( defined $sth->errstr ) {
1406 $error .= $sth->errstr;
1409 # item stored, now, deal with the marc part...
1410 $sth = $dbh->prepare("select biblioitems.marc,biblio.frameworkcode from biblioitems,biblio
1411 where biblio.biblionumber=biblioitems.biblionumber and
1412 biblio.biblionumber=?");
1413 $sth->execute($item->{biblionumber});
1414 if ( defined $sth->errstr ) {
1415 $error .= $sth->errstr;
1417 my ($rawmarc,$frameworkcode) = $sth->fetchrow;
1418 warn "ERROR IN REALnewitem, MARC record not found FOR $item->{biblionumber} => $rawmarc <=" unless $rawmarc;
1419 my $record = MARC::File::USMARC::decode($rawmarc);
1420 # ok, we have the marc record, add item number to the item field (in {marc}, and add the field to the record)
1421 my ($itemnumberfield,$itemnumbersubfield) = MARCfind_marc_from_kohafield($dbh,'items.itemnumber',$frameworkcode);
1422 my $itemrecord = MARC::Record->new_from_usmarc($item->{marc});
1424 warn $itemnumberfield;
1425 warn $itemrecord->field($itemnumberfield);
1426 my $itemfield = $itemrecord->field($itemnumberfield);
1427 $itemfield->add_subfields($itemnumbersubfield => "$itemnumber");
1428 $record->insert_grouped_field($itemfield);
1429 # save the record into biblioitem
1430 $sth=$dbh->prepare("update biblioitems set marc=?,marcxml=? where biblionumber=?");
1431 $sth->execute($record->as_usmarc(),$record->as_xml(),$item->{biblionumber});
1432 if ( defined $sth->errstr ) {
1433 $error .= $sth->errstr;
1435 zebra_create($item->{biblionumber},$record);
1436 $dbh->do('unlock tables');
1437 return ( $itemnumber, $error );
1440 =head2 REALmoditem($dbh,$item);
1451 my ( $dbh, $item ) = @_;
1453 $dbh->do('lock tables items WRITE, biblio WRITE,biblioitems WRITE');
1454 $item->{'itemnum'} = $item->{'itemnumber'} unless $item->{'itemnum'};
1455 my $query = "update items set barcode=?,itemnotes=?,itemcallnumber=?,notforloan=?,location=?,multivolumepart=?,multivolume=?,stack=?,wthdrawn=?";
1457 $item->{'barcode'}, $item->{'itemnotes'},
1458 $item->{'itemcallnumber'}, $item->{'notforloan'},
1459 $item->{'location'}, $item->{multivolumepart},
1460 $item->{multivolume}, $item->{stack},
1463 if ( $item->{'lost'} ne '' ) {
1464 $query = "update items set biblioitemnumber=?,barcode=?,itemnotes=?,homebranch=?,
1465 itemlost=?,wthdrawn=?,itemcallnumber=?,notforloan=?,
1466 location=?,multivolumepart=?,multivolume=?,stack=?,wthdrawn=?";
1468 $item->{'bibitemnum'}, $item->{'barcode'},
1469 $item->{'itemnotes'}, $item->{'homebranch'},
1470 $item->{'lost'}, $item->{'wthdrawn'},
1471 $item->{'itemcallnumber'}, $item->{'notforloan'},
1472 $item->{'location'}, $item->{multivolumepart},
1473 $item->{multivolume}, $item->{stack},
1476 if ($item->{homebranch}) {
1477 $query.=",homebranch=?";
1478 push @bind, $item->{homebranch};
1480 if ($item->{holdingbranch}) {
1481 $query.=",holdingbranch=?";
1482 push @bind, $item->{holdingbranch};
1485 $query.=" where itemnumber=?";
1486 push @bind,$item->{'itemnum'};
1487 if ( $item->{'replacement'} ne '' ) {
1488 $query =~ s/ where/,replacementprice='$item->{'replacement'}' where/;
1490 my $sth = $dbh->prepare($query);
1491 $sth->execute(@bind);
1493 # item stored, now, deal with the marc part...
1494 $sth = $dbh->prepare("select biblioitems.marc,biblio.frameworkcode from biblioitems,biblio
1495 where biblio.biblionumber=biblioitems.biblionumber and
1496 biblio.biblionumber=? and
1497 biblioitems.biblioitemnumber=?");
1498 $sth->execute($item->{biblionumber},$item->{biblioitemnumber});
1499 if ( defined $sth->errstr ) {
1500 $error .= $sth->errstr;
1502 my ($rawmarc,$frameworkcode) = $sth->fetchrow;
1503 warn "ERROR IN REALmoditem, MARC record not found" unless $rawmarc;
1504 my $record = MARC::File::USMARC::decode($rawmarc);
1505 # ok, we have the marc record, find the previous item record for this itemnumber and delete it
1506 my ($itemnumberfield,$itemnumbersubfield) = MARCfind_marc_from_kohafield($dbh,'items.itemnumber',$frameworkcode);
1507 # prepare the new item record
1508 my $itemrecord = MARC::File::USMARC::decode($item->{marc});
1509 my $itemfield = $itemrecord->field($itemnumberfield);
1510 $itemfield->add_subfields($itemnumbersubfield => '$itemnumber');
1511 # parse all fields fields from the complete record
1512 foreach ($record->field($itemnumberfield)) {
1513 # when the previous field is found, replace by the new one
1514 if ($_->subfield($itemnumbersubfield) == $item->{itemnum}) {
1515 $_->replace_with($itemfield);
1518 # $record->insert_grouped_field($itemfield);
1519 # save the record into biblioitem
1520 $sth=$dbh->prepare("update biblioitems set marc=?,marcxml=? where biblionumber=? and biblioitemnumber=?");
1521 $sth->execute($record->as_usmarc(),$record->as_xml(),$item->{biblionumber},$item->{biblioitemnumber});
1522 zebra_create($item->biblionumber,$record);
1523 if ( defined $sth->errstr ) {
1524 $error .= $sth->errstr;
1526 $dbh->do('unlock tables');
1531 =head2 REALdelitem($dbh,$itemnum);
1542 my ( $dbh, $itemnum ) = @_;
1544 # my $dbh=C4Connect;
1545 my $sth = $dbh->prepare("select * from items where itemnumber=?");
1546 $sth->execute($itemnum);
1547 my $data = $sth->fetchrow_hashref;
1549 my $query = "Insert into deleteditems set ";
1551 foreach my $temp ( keys %$data ) {
1552 $query .= "$temp = ?,";
1553 push ( @bind, $data->{$temp} );
1558 $sth = $dbh->prepare($query);
1559 $sth->execute(@bind);
1561 $sth = $dbh->prepare("Delete from items where itemnumber=?");
1562 $sth->execute($itemnum);
1568 =head2 REALdelbiblioitem($dbh,$biblioitemnumber);
1572 deletes a biblioitem
1573 NOTE : not standard sub name. Should be REALdelbiblioitem()
1579 sub REALdelbiblioitem {
1580 my ( $dbh, $biblioitemnumber ) = @_;
1582 # my $dbh = C4Connect;
1583 my $sth = $dbh->prepare( "Select * from biblioitems
1584 where biblioitemnumber = ?"
1588 $sth->execute($biblioitemnumber);
1590 if ( $results = $sth->fetchrow_hashref ) {
1594 "Insert into deletedbiblioitems (biblioitemnumber, biblionumber, volume, number, classification, itemtype,
1595 isbn, issn ,dewey ,subclass ,publicationyear ,publishercode ,volumedate ,volumeddesc ,timestamp ,illus ,
1596 pages ,notes ,size ,url ,lccn ) values(?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)"
1600 $results->{biblioitemnumber}, $results->{biblionumber},
1601 $results->{volume}, $results->{number},
1602 $results->{classification}, $results->{itemtype},
1603 $results->{isbn}, $results->{issn},
1604 $results->{dewey}, $results->{subclass},
1605 $results->{publicationyear}, $results->{publishercode},
1606 $results->{volumedate}, $results->{volumeddesc},
1607 $results->{timestamp}, $results->{illus},
1608 $results->{pages}, $results->{notes},
1609 $results->{size}, $results->{url},
1613 $dbh->prepare("Delete from biblioitems where biblioitemnumber = ?");
1614 $sth2->execute($biblioitemnumber);
1619 # Now delete all the items attached to the biblioitem
1620 $sth = $dbh->prepare("Select * from items where biblioitemnumber = ?");
1621 $sth->execute($biblioitemnumber);
1623 while ( my $data = $sth->fetchrow_hashref ) {
1624 my $query = "Insert into deleteditems set ";
1626 foreach my $temp ( keys %$data ) {
1627 $query .= "$temp = ?,";
1628 push ( @bind, $data->{$temp} );
1631 my $sth2 = $dbh->prepare($query);
1632 $sth2->execute(@bind);
1635 $sth = $dbh->prepare("Delete from items where biblioitemnumber = ?");
1636 $sth->execute($biblioitemnumber);
1640 } # sub deletebiblioitem
1642 =head2 REALdelbiblio($dbh,$biblio);
1653 my ( $dbh, $biblio ) = @_;
1654 my $sth = $dbh->prepare("select * from biblio where biblionumber=?");
1655 $sth->execute($biblio);
1656 if ( my $data = $sth->fetchrow_hashref ) {
1658 my $query = "Insert into deletedbiblio set ";
1660 foreach my $temp ( keys %$data ) {
1661 $query .= "$temp = ?,";
1662 push ( @bind, $data->{$temp} );
1665 #replacing the last , by ",?)"
1667 $sth = $dbh->prepare($query);
1668 $sth->execute(@bind);
1670 $sth = $dbh->prepare("Delete from biblio where biblionumber=?");
1671 $sth->execute($biblio);
1677 =head2 $number = itemcount($biblio);
1681 returns the number of items attached to a biblio
1689 my $dbh = C4::Context->dbh;
1692 my $sth = $dbh->prepare("Select count(*) from items where biblionumber=?");
1693 $sth->execute($biblio);
1694 my $data = $sth->fetchrow_hashref;
1696 return ( $data->{'count(*)'} );
1699 =head2 $biblionumber = newbiblio($biblio);
1703 create a biblio. The parameter is a hash
1711 my $dbh = C4::Context->dbh;
1712 my $bibnum = REALnewbiblio( $dbh, $biblio );
1713 # finds new (MARC bibid
1714 # my $bibid = &MARCfind_MARCbibid_from_oldbiblionumber($dbh,$bibnum);
1715 # my $record = &MARCkoha2marcBiblio( $dbh, $bibnum );
1716 # MARCaddbiblio( $dbh, $record, $bibnum,'' );
1720 =head2 $biblionumber = &modbiblio($biblio);
1724 Update a biblio record.
1726 C<$biblio> is a reference-to-hash whose keys are the fields in the
1727 biblio table in the Koha database. All fields must be present, not
1728 just the ones you wish to change.
1730 C<&modbiblio> updates the record defined by
1731 C<$biblio-E<gt>{biblionumber}> with the values in C<$biblio>.
1733 C<&modbiblio> returns C<$biblio-E<gt>{biblionumber}> whether it was
1742 my $dbh = C4::Context->dbh;
1743 my $biblionumber=REALmodbiblio($dbh,$biblio);
1744 my $record = MARCkoha2marcBiblio($dbh,$biblionumber,$biblionumber);
1745 # finds new (MARC bibid
1746 my $bibid = &MARCfind_MARCbibid_from_oldbiblionumber($dbh,$biblionumber);
1747 MARCmodbiblio($dbh,$bibid,$record,"",0);
1748 return($biblionumber);
1751 =head2 &modsubtitle($biblionumber, $subtitle);
1755 Sets the subtitle of a book.
1757 C<$biblionumber> is the biblionumber of the book to modify.
1759 C<$subtitle> is the new subtitle.
1766 my ( $bibnum, $subtitle ) = @_;
1767 my $dbh = C4::Context->dbh;
1768 &REALmodsubtitle( $dbh, $bibnum, $subtitle );
1771 =head2 &modaddauthor($biblionumber, $author);
1775 Replaces all additional authors for the book with biblio number
1776 C<$biblionumber> with C<$author>. If C<$author> is the empty string,
1777 C<&modaddauthor> deletes all additional authors.
1784 my ( $bibnum, @authors ) = @_;
1785 my $dbh = C4::Context->dbh;
1786 &REALmodaddauthor( $dbh, $bibnum, @authors );
1787 } # sub modaddauthor
1789 =head2 $error = &modsubject($biblionumber, $force, @subjects);
1793 $force - a subject to force
1794 $error - Error message, or undef if successful.
1801 my ( $bibnum, $force, @subject ) = @_;
1802 my $dbh = C4::Context->dbh;
1803 my $error = &REALmodsubject( $dbh, $bibnum, $force, @subject );
1805 # When MARC is off, ensures that the MARC biblio table gets updated with new
1806 # subjects, of course, it deletes the biblio in marc, and then recreates.
1807 # This check is to ensure that no MARC data exists to lose.
1808 # if (C4::Context->preference("MARC") eq '0'){
1809 # warn "in modSUBJECT";
1810 # my $MARCRecord = &MARCkoha2marcBiblio($dbh,$bibnum);
1811 # my $bibid = &MARCfind_MARCbibid_from_oldbiblionumber($dbh,$bibnum);
1812 # &MARCmodbiblio($dbh,$bibid, $MARCRecord);
1818 =head2 modbibitem($biblioitem);
1822 modify a biblioitem. The parameter is a hash
1829 my ($biblioitem) = @_;
1830 my $dbh = C4::Context->dbh;
1831 &REALmodbiblioitem( $dbh, $biblioitem );
1834 =head2 $biblioitemnumber = newbiblioitem($biblioitem)
1838 create a biblioitem, the parameter is a hash
1845 my ($biblioitem) = @_;
1846 my $dbh = C4::Context->dbh;
1847 # add biblio information to the hash
1848 my $MARCbiblio = MARCkoha2marcBiblio( $dbh, $biblioitem );
1849 $biblioitem->{marc} = $MARCbiblio->as_usmarc();
1850 my $bibitemnum = &REALnewbiblioitem( $dbh, $biblioitem );
1851 return ($bibitemnum);
1854 =head2 newsubtitle($biblionumber,$subtitle);
1858 insert a subtitle for $biblionumber biblio
1866 my ( $bibnum, $subtitle ) = @_;
1867 my $dbh = C4::Context->dbh;
1868 &REALnewsubtitle( $dbh, $bibnum, $subtitle );
1871 =head2 $errors = newitems($item, @barcodes);
1875 insert items ($item is a hash)
1883 my ( $item, @barcodes ) = @_;
1884 my $dbh = C4::Context->dbh;
1888 foreach my $barcode (@barcodes) {
1889 # add items, one by one for each barcode.
1891 $oneitem->{barcode}= $barcode;
1892 my $MARCitem = &MARCkoha2marcItem( $dbh, $oneitem);
1893 $oneitem->{marc} = $MARCitem->as_usmarc;
1894 ( $itemnumber, $error ) = &REALnewitems( $dbh, $oneitem);
1895 # $errors .= $error;
1896 # &MARCadditem( $dbh, $MARCitem, $item->{biblionumber} );
1901 =head2 moditem($item);
1905 modify an item ($item is a hash with all item informations)
1914 my $dbh = C4::Context->dbh;
1915 &REALmoditem( $dbh, $item );
1917 &MARCkoha2marcItem( $dbh, $item->{'biblionumber'}, $item->{'itemnum'} );
1919 &MARCfind_MARCbibid_from_oldbiblionumber( $dbh, $item->{biblionumber} );
1920 &MARCmoditem( $dbh, $MARCitem, $bibid, $item->{itemnum}, 0 );
1923 =head2 $error = checkitems($count,@barcodes);
1927 check for each @barcode entry that the barcode is not a duplicate
1934 my ( $count, @barcodes ) = @_;
1935 my $dbh = C4::Context->dbh;
1937 my $sth = $dbh->prepare("Select * from items where barcode=?");
1938 for ( my $i = 0 ; $i < $count ; $i++ ) {
1939 $barcodes[$i] = uc $barcodes[$i];
1940 $sth->execute( $barcodes[$i] );
1941 if ( my $data = $sth->fetchrow_hashref ) {
1942 $error .= " Duplicate Barcode: $barcodes[$i]";
1949 =head2 $delitem($itemnum);
1953 delete item $itemnum being the item number to delete
1961 my $dbh = C4::Context->dbh;
1962 &REALdelitem( $dbh, $itemnum );
1965 =head2 deletebiblioitem($biblioitemnumber);
1969 delete the biblioitem $biblioitemnumber
1975 sub deletebiblioitem {
1976 my ($biblioitemnumber) = @_;
1977 my $dbh = C4::Context->dbh;
1978 &REALdelbiblioitem( $dbh, $biblioitemnumber );
1979 } # sub deletebiblioitem
1981 =head2 delbiblio($biblionumber)
1985 delete biblio $biblionumber
1993 my $dbh = C4::Context->dbh;
1994 &REALdelbiblio( $dbh, $biblio );
1995 my $bibid = &MARCfind_MARCbibid_from_oldbiblionumber( $dbh, $biblio );
1996 &MARCdelbiblio( $dbh, $bibid, 0 );
1999 =head2 ($count,@results) = getbiblio($biblionumber);
2003 return an array with hash of biblios.
2005 FIXME : biblionumber being the primary key, this sub will always return only 1 result, API should be modified...
2012 my ($biblionumber) = @_;
2013 my $dbh = C4::Context->dbh;
2014 my $sth = $dbh->prepare("Select * from biblio where biblionumber = ?");
2016 # || die "Cannot prepare $query\n" . $dbh->errstr;
2020 $sth->execute($biblionumber);
2022 # || die "Cannot execute $query\n" . $sth->errstr;
2023 while ( my $data = $sth->fetchrow_hashref ) {
2024 $results[$count] = $data;
2029 return ( $count, @results );
2034 $data = &bibdata($biblionumber, $type);
2036 Returns information about the book with the given biblionumber.
2038 C<$type> is ignored.
2040 C<&bibdata> returns a reference-to-hash. The keys are the fields in
2041 the C<biblio>, C<biblioitems>, and C<bibliosubtitle> tables in the
2044 In addition, C<$data-E<gt>{subject}> is the list of the book's
2045 subjects, separated by C<" , "> (space, comma, space).
2047 If there are multiple biblioitems with the given biblionumber, only
2048 the first one is considered.
2053 my ($bibnum, $type) = @_;
2054 my $dbh = C4::Context->dbh;
2055 my $sth = $dbh->prepare("Select *, biblioitems.notes AS bnotes, biblio.notes
2057 left join biblioitems on biblioitems.biblionumber = biblio.biblionumber
2058 left join bibliosubtitle on
2059 biblio.biblionumber = bibliosubtitle.biblionumber
2060 left join itemtypes on biblioitems.itemtype=itemtypes.itemtype
2061 where biblio.biblionumber = ?
2063 $sth->execute($bibnum);
2065 $data = $sth->fetchrow_hashref;
2067 # handle management of repeated subtitle
2068 $sth = $dbh->prepare("Select * from bibliosubtitle where biblionumber = ?");
2069 $sth->execute($bibnum);
2071 while (my $dat = $sth->fetchrow_hashref){
2073 $line{subtitle} = $dat->{subtitle};
2074 push @subtitles, \%line;
2076 $data->{subtitles} = \@subtitles;
2078 $sth = $dbh->prepare("Select * from bibliosubject where biblionumber = ?");
2079 $sth->execute($bibnum);
2081 while (my $dat = $sth->fetchrow_hashref){
2083 $line{subject} = $dat->{'subject'};
2084 push @subjects, \%line;
2086 $data->{subjects} = \@subjects;
2088 $sth = $dbh->prepare("Select * from additionalauthors where biblionumber = ?");
2089 $sth->execute($bibnum);
2090 while (my $dat = $sth->fetchrow_hashref){
2091 $data->{'additionalauthors'} .= "$dat->{'author'} - ";
2093 chop $data->{'additionalauthors'};
2094 chop $data->{'additionalauthors'};
2095 chop $data->{'additionalauthors'};
2100 =head2 ($count,@results) = getbiblioitem($biblioitemnumber);
2104 return an array with hash of biblioitemss.
2106 FIXME : biblioitemnumber being unique, this sub will always return only 1 result, API should be modified...
2113 my ($biblioitemnum) = @_;
2114 my $dbh = C4::Context->dbh;
2115 my $sth = $dbh->prepare( "Select * from biblioitems where
2116 biblioitemnumber = ?"
2121 $sth->execute($biblioitemnum);
2123 while ( my $data = $sth->fetchrow_hashref ) {
2124 $results[$count] = $data;
2129 return ( $count, @results );
2130 } # sub getbiblioitem
2132 =head2 ($count,@results) = getbiblioitembybiblionumber($biblionumber);
2136 return an array with hash of biblioitems for the given biblionumber.
2142 sub getbiblioitembybiblionumber {
2143 my ($biblionumber) = @_;
2144 my $dbh = C4::Context->dbh;
2145 my $sth = $dbh->prepare("Select * from biblioitems where biblionumber = ?");
2149 $sth->execute($biblionumber);
2151 while ( my $data = $sth->fetchrow_hashref ) {
2152 $results[$count] = $data;
2157 return ( $count, @results );
2160 =head2 ($count,@results) = getitemsbybiblioitem($biblionumber);
2164 returns an array with hash of items
2170 sub getitemsbybiblioitem {
2171 my ($biblioitemnum) = @_;
2172 my $dbh = C4::Context->dbh;
2173 my $sth = $dbh->prepare( "Select * from items, biblio where
2174 biblio.biblionumber = items.biblionumber and biblioitemnumber
2178 # || die "Cannot prepare $query\n" . $dbh->errstr;
2182 $sth->execute($biblioitemnum);
2184 # || die "Cannot execute $query\n" . $sth->errstr;
2185 while ( my $data = $sth->fetchrow_hashref ) {
2186 $results[$count] = $data;
2191 return ( $count, @results );
2192 } # sub getitemsbybiblioitem
2196 @results = &ItemInfo($env, $biblionumber, $type);
2198 Returns information about books with the given biblionumber.
2200 C<$type> may be either C<intra> or anything else. If it is not set to
2201 C<intra>, then the search will exclude lost, very overdue, and
2206 C<&ItemInfo> returns a list of references-to-hash. Each element
2207 contains a number of keys. Most of them are table items from the
2208 C<biblio>, C<biblioitems>, C<items>, and C<itemtypes> tables in the
2209 Koha database. Other keys include:
2213 =item C<$data-E<gt>{branchname}>
2215 The name (not the code) of the branch to which the book belongs.
2217 =item C<$data-E<gt>{datelastseen}>
2219 This is simply C<items.datelastseen>, except that while the date is
2220 stored in YYYY-MM-DD format in the database, here it is converted to
2221 DD/MM/YYYY format. A NULL date is returned as C<//>.
2223 =item C<$data-E<gt>{datedue}>
2225 =item C<$data-E<gt>{class}>
2227 This is the concatenation of C<biblioitems.classification>, the book's
2228 Dewey code, and C<biblioitems.subclass>.
2230 =item C<$data-E<gt>{ocount}>
2232 I think this is the number of copies of the book available.
2234 =item C<$data-E<gt>{order}>
2236 If this is set, it is set to C<One Order>.
2243 my ($env,$biblionumber,$type) = @_;
2244 my $dbh = C4::Context->dbh;
2245 my $query = "SELECT *,items.notforloan as itemnotforloan FROM items, biblio, biblioitems
2246 left join itemtypes on biblioitems.itemtype = itemtypes.itemtype
2247 WHERE items.biblionumber = ?
2248 AND biblioitems.biblioitemnumber = items.biblioitemnumber
2249 AND biblio.biblionumber = items.biblionumber";
2250 $query .= " order by items.dateaccessioned desc";
2251 my $sth=$dbh->prepare($query);
2252 $sth->execute($biblionumber);
2255 while (my $data=$sth->fetchrow_hashref){
2257 my $isth=$dbh->prepare("Select issues.*,borrowers.cardnumber from issues,borrowers where itemnumber = ? and returndate is null and issues.borrowernumber=borrowers.borrowernumber");
2258 $isth->execute($data->{'itemnumber'});
2259 if (my $idata=$isth->fetchrow_hashref){
2260 $data->{borrowernumber} = $idata->{borrowernumber};
2261 $data->{cardnumber} = $idata->{cardnumber};
2262 $datedue = format_date($idata->{'date_due'});
2264 if ($datedue eq ''){
2265 my ($restype,$reserves)=C4::Reserves2::CheckReserves($data->{'itemnumber'});
2271 #get branch information.....
2272 my $bsth=$dbh->prepare("SELECT * FROM branches WHERE branchcode = ?");
2273 $bsth->execute($data->{'holdingbranch'});
2274 if (my $bdata=$bsth->fetchrow_hashref){
2275 $data->{'branchname'} = $bdata->{'branchname'};
2277 my $date=format_date($data->{'datelastseen'});
2278 $data->{'datelastseen'}=$date;
2279 $data->{'datedue'}=$datedue;
2280 # get notforloan complete status if applicable
2281 my $sthnflstatus = $dbh->prepare('select authorised_value from marc_subfield_structure where kohafield="items.notforloan"');
2282 $sthnflstatus->execute;
2283 my ($authorised_valuecode) = $sthnflstatus->fetchrow;
2284 if ($authorised_valuecode) {
2285 $sthnflstatus = $dbh->prepare("select lib from authorised_values where category=? and authorised_value=?");
2286 $sthnflstatus->execute($authorised_valuecode,$data->{itemnotforloan});
2287 my ($lib) = $sthnflstatus->fetchrow;
2288 $data->{notforloan} = $lib;
2299 ($count, @results) = &bibitems($biblionumber);
2301 Given the biblionumber for a book, C<&bibitems> looks up that book's
2302 biblioitems (different publications of the same book, the audio book
2303 and film versions, etc.).
2305 C<$count> is the number of elements in C<@results>.
2307 C<@results> is an array of references-to-hash; the keys are the fields
2308 of the C<biblioitems> and C<itemtypes> tables of the Koha database. In
2309 addition, C<itemlost> indicates the availability of the item: if it is
2310 "2", then all copies of the item are long overdue; if it is "1", then
2311 all copies are lost; otherwise, there is at least one copy available.
2317 my $dbh = C4::Context->dbh;
2318 my $sth = $dbh->prepare("SELECT biblioitems.*,
2320 MIN(items.itemlost) as itemlost,
2321 MIN(items.dateaccessioned) as dateaccessioned
2322 FROM biblioitems, itemtypes, items
2323 WHERE biblioitems.biblionumber = ?
2324 AND biblioitems.itemtype = itemtypes.itemtype
2325 AND biblioitems.biblioitemnumber = items.biblioitemnumber
2326 GROUP BY items.biblioitemnumber");
2329 $sth->execute($bibnum);
2330 while (my $data = $sth->fetchrow_hashref) {
2331 $results[$count] = $data;
2335 return($count, @results);
2341 $itemdata = &bibitemdata($biblioitemnumber);
2343 Looks up the biblioitem with the given biblioitemnumber. Returns a
2344 reference-to-hash. The keys are the fields from the C<biblio>,
2345 C<biblioitems>, and C<itemtypes> tables in the Koha database, except
2346 that C<biblioitems.notes> is given as C<$itemdata-E<gt>{bnotes}>.
2352 my $dbh = C4::Context->dbh;
2353 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");
2356 $sth->execute($bibitem);
2358 $data = $sth->fetchrow_hashref;
2365 =item getbibliofromitemnumber
2367 $item = &getbibliofromitemnumber($env, $dbh, $itemnumber);
2369 Looks up the item with the given itemnumber.
2371 C<$env> and C<$dbh> are ignored.
2373 C<&itemnodata> returns a reference-to-hash whose keys are the fields
2374 from the C<biblio>, C<biblioitems>, and C<items> tables in the Koha
2379 sub getbibliofromitemnumber {
2380 my ($env,$dbh,$itemnumber) = @_;
2381 $dbh = C4::Context->dbh;
2382 my $sth=$dbh->prepare("Select * from biblio,items,biblioitems
2383 where items.itemnumber = ?
2384 and biblio.biblionumber = items.biblionumber
2385 and biblioitems.biblioitemnumber = items.biblioitemnumber");
2387 $sth->execute($itemnumber);
2388 my $data=$sth->fetchrow_hashref;
2395 @barcodes = &barcodes($biblioitemnumber);
2397 Given a biblioitemnumber, looks up the corresponding items.
2399 Returns an array of references-to-hash; the keys are C<barcode> and
2402 The returned items include very overdue items, but not lost ones.
2407 #called from request.pl
2408 my ($biblioitemnumber)=@_;
2409 my $dbh = C4::Context->dbh;
2410 my $sth=$dbh->prepare("SELECT barcode, itemlost, holdingbranch FROM items
2411 WHERE biblioitemnumber = ?
2412 AND (wthdrawn <> 1 OR wthdrawn IS NULL)");
2413 $sth->execute($biblioitemnumber);
2416 while (my $data=$sth->fetchrow_hashref){
2417 $barcodes[$i]=$data;
2427 $item = &itemdata($barcode);
2429 Looks up the item with the given barcode, and returns a
2430 reference-to-hash containing information about that item. The keys of
2431 the hash are the fields from the C<items> and C<biblioitems> tables in
2436 sub get_item_from_barcode {
2438 my $dbh = C4::Context->dbh;
2439 my $sth=$dbh->prepare("Select * from items,biblioitems where barcode=?
2440 and items.biblioitemnumber=biblioitems.biblioitemnumber");
2441 $sth->execute($barcode);
2442 my $data=$sth->fetchrow_hashref;
2450 @issues = &itemissues($biblioitemnumber, $biblio);
2452 Looks up information about who has borrowed the bookZ<>(s) with the
2453 given biblioitemnumber.
2455 C<$biblio> is ignored.
2457 C<&itemissues> returns an array of references-to-hash. The keys
2458 include the fields from the C<items> table in the Koha database.
2459 Additional keys include:
2465 If the item is currently on loan, this gives the due date.
2467 If the item is not on loan, then this is either "Available" or
2468 "Cancelled", if the item has been withdrawn.
2472 If the item is currently on loan, this gives the card number of the
2473 patron who currently has the item.
2475 =item C<timestamp0>, C<timestamp1>, C<timestamp2>
2477 These give the timestamp for the last three times the item was
2480 =item C<card0>, C<card1>, C<card2>
2482 The card number of the last three patrons who borrowed this item.
2484 =item C<borrower0>, C<borrower1>, C<borrower2>
2486 The borrower number of the last three patrons who borrowed this item.
2493 my ($bibitem, $biblio)=@_;
2494 my $dbh = C4::Context->dbh;
2495 # FIXME - If this function die()s, the script will abort, and the
2496 # user won't get anything; depending on how far the script has
2497 # gotten, the user might get a blank page. It would be much better
2498 # to at least print an error message. The easiest way to do this
2499 # is to set $SIG{__DIE__}.
2500 my $sth = $dbh->prepare("Select * from items where
2501 items.biblioitemnumber = ?")
2502 || die $dbh->errstr;
2506 $sth->execute($bibitem)
2507 || die $sth->errstr;
2509 while (my $data = $sth->fetchrow_hashref) {
2510 # Find out who currently has this item.
2511 # FIXME - Wouldn't it be better to do this as a left join of
2512 # some sort? Currently, this code assumes that if
2513 # fetchrow_hashref() fails, then the book is on the shelf.
2514 # fetchrow_hashref() can fail for any number of reasons (e.g.,
2515 # database server crash), not just because no items match the
2517 my $sth2 = $dbh->prepare("select * from issues,borrowers
2518 where itemnumber = ?
2519 and returndate is NULL
2520 and issues.borrowernumber = borrowers.borrowernumber");
2522 $sth2->execute($data->{'itemnumber'});
2523 if (my $data2 = $sth2->fetchrow_hashref) {
2524 $data->{'date_due'} = $data2->{'date_due'};
2525 $data->{'card'} = $data2->{'cardnumber'};
2526 $data->{'borrower'} = $data2->{'borrowernumber'};
2528 if ($data->{'wthdrawn'} eq '1') {
2529 $data->{'date_due'} = 'Cancelled';
2531 $data->{'date_due'} = 'Available';
2537 # Find the last 3 people who borrowed this item.
2538 $sth2 = $dbh->prepare("select * from issues, borrowers
2539 where itemnumber = ?
2540 and issues.borrowernumber = borrowers.borrowernumber
2541 and returndate is not NULL
2542 order by returndate desc,timestamp desc") || die $dbh->errstr;
2543 $sth2->execute($data->{'itemnumber'}) || die $sth2->errstr;
2544 for (my $i2 = 0; $i2 < 2; $i2++) { # FIXME : error if there is less than 3 pple borrowing this item
2545 if (my $data2 = $sth2->fetchrow_hashref) {
2546 $data->{"timestamp$i2"} = $data2->{'timestamp'};
2547 $data->{"card$i2"} = $data2->{'cardnumber'};
2548 $data->{"borrower$i2"} = $data2->{'borrowernumber'};
2553 $results[$i] = $data;
2563 ($count, $subjects) = &getsubject($biblionumber);
2565 Looks up the subjects of the book with the given biblionumber. Returns
2566 a two-element list. C<$subjects> is a reference-to-array, where each
2567 element is a subject of the book, and C<$count> is the number of
2568 elements in C<$subjects>.
2574 my $dbh = C4::Context->dbh;
2575 my $sth=$dbh->prepare("Select * from bibliosubject where biblionumber=?");
2576 $sth->execute($bibnum);
2579 while (my $data=$sth->fetchrow_hashref){
2584 return($i,\@results);
2589 ($count, $authors) = &getaddauthor($biblionumber);
2591 Looks up the additional authors for the book with the given
2594 Returns a two-element list. C<$authors> is a reference-to-array, where
2595 each element is an additional author, and C<$count> is the number of
2596 elements in C<$authors>.
2602 my $dbh = C4::Context->dbh;
2603 my $sth=$dbh->prepare("Select * from additionalauthors where biblionumber=?");
2604 $sth->execute($bibnum);
2607 while (my $data=$sth->fetchrow_hashref){
2612 return($i,\@results);
2618 ($count, $subtitles) = &getsubtitle($biblionumber);
2620 Looks up the subtitles for the book with the given biblionumber.
2622 Returns a two-element list. C<$subtitles> is a reference-to-array,
2623 where each element is a subtitle, and C<$count> is the number of
2624 elements in C<$subtitles>.
2630 my $dbh = C4::Context->dbh;
2631 my $sth=$dbh->prepare("Select * from bibliosubtitle where biblionumber=?");
2632 $sth->execute($bibnum);
2635 while (my $data=$sth->fetchrow_hashref){
2640 return($i,\@results);
2646 ($count, @websites) = &getwebsites($biblionumber);
2648 Looks up the web sites pertaining to the book with the given
2651 C<$count> is the number of elements in C<@websites>.
2653 C<@websites> is an array of references-to-hash; the keys are the
2654 fields from the C<websites> table in the Koha database.
2657 #FIXME : could maybe be deleted. Otherwise, would be better in a Websites.pm package
2658 #(with add / modify / delete subs)
2661 my ($biblionumber) = @_;
2662 my $dbh = C4::Context->dbh;
2663 my $sth = $dbh->prepare("Select * from websites where biblionumber = ?");
2667 $sth->execute($biblionumber);
2668 while (my $data = $sth->fetchrow_hashref) {
2669 # FIXME - The URL scheme shouldn't be stripped off, at least
2670 # not here, since it's part of the URL, and will be useful in
2671 # constructing a link to the site. If you don't want the user
2672 # to see the "http://" part, strip that off when building the
2674 $data->{'url'} =~ s/^http:\/\///; # FIXME - Leaning toothpick
2676 $results[$count] = $data;
2681 return($count, @results);
2684 =item getwebbiblioitems
2686 ($count, @results) = &getwebbiblioitems($biblionumber);
2688 Given a book's biblionumber, looks up the web versions of the book
2689 (biblioitems with itemtype C<WEB>).
2691 C<$count> is the number of items in C<@results>. C<@results> is an
2692 array of references-to-hash; the keys are the items from the
2693 C<biblioitems> table of the Koha database.
2697 sub getwebbiblioitems {
2698 my ($biblionumber) = @_;
2699 my $dbh = C4::Context->dbh;
2700 my $sth = $dbh->prepare("Select * from biblioitems where biblionumber = ?
2701 and itemtype = 'WEB'");
2705 $sth->execute($biblionumber);
2706 while (my $data = $sth->fetchrow_hashref) {
2707 $data->{'url'} =~ s/^http:\/\///;
2708 $results[$count] = $data;
2713 return($count, @results);
2714 } # sub getwebbiblioitems
2718 # converts ISO 5426 coded string to ISO 8859-1
2719 # sloppy code : should be improved in next issue
2720 my ( $string, $encoding ) = @_;
2723 # $encoding = C4::Context->preference("marcflavour") unless $encoding;
2724 if ( $encoding eq "UNIMARC" ) {
2793 # this handles non-sorting blocks (if implementation requires this)
2794 $string = nsb_clean($_);
2796 elsif ( $encoding eq "USMARC" || $encoding eq "MARC21" ) {
2797 if (/[\xc1-\xff]/) {
2850 # this handles non-sorting blocks (if implementation requires this)
2851 $string = nsb_clean($_);
2858 my $NSB = '\x88'; # NSB : begin Non Sorting Block
2859 my $NSE = '\x89'; # NSE : Non Sorting Block end
2860 # handles non sorting blocks
2864 s/[ ]{0,1}$NSE/) /gm;
2871 my $dbh = C4::Context->dbh;
2872 my $result = MARCmarc2koha($dbh,$record,'');
2874 my ($biblionumber,$bibid,$title);
2875 # search duplicate on ISBN, easy and fast...
2876 if ($result->{isbn}) {
2877 $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=?");
2878 $sth->execute($result->{'isbn'});
2879 ($biblionumber,$bibid,$title) = $sth->fetchrow;
2880 return $biblionumber,$bibid,$title if ($biblionumber);
2882 # a more complex search : build a request for SearchMarc::catalogsearch()
2883 my (@tags, @and_or, @excluding, @operator, @value, $offset,$length);
2884 # search on biblio.title
2885 my ($tag,$subfield) = MARCfind_marc_from_kohafield($dbh,"biblio.title","");
2886 if ($record->field($tag)) {
2887 if ($record->field($tag)->subfields($subfield)) {
2888 push @tags, "'".$tag.$subfield."'";
2889 push @and_or, "and";
2890 push @excluding, "";
2891 push @operator, "contains";
2892 push @value, $record->field($tag)->subfield($subfield);
2893 # warn "for title, I add $tag / $subfield".$record->field($tag)->subfield($subfield);
2896 # ... and on biblio.author
2897 ($tag,$subfield) = MARCfind_marc_from_kohafield($dbh,"biblio.author","");
2898 if ($record->field($tag)) {
2899 if ($record->field($tag)->subfields($subfield)) {
2900 push @tags, "'".$tag.$subfield."'";
2901 push @and_or, "and";
2902 push @excluding, "";
2903 push @operator, "contains";
2904 push @value, $record->field($tag)->subfield($subfield);
2905 # warn "for author, I add $tag / $subfield".$record->field($tag)->subfield($subfield);
2908 # ... and on publicationyear.
2909 ($tag,$subfield) = MARCfind_marc_from_kohafield($dbh,"biblioitems.publicationyear","");
2910 if ($record->field($tag)) {
2911 if ($record->field($tag)->subfields($subfield)) {
2912 push @tags, "'".$tag.$subfield."'";
2913 push @and_or, "and";
2914 push @excluding, "";
2915 push @operator, "=";
2916 push @value, $record->field($tag)->subfield($subfield);
2917 # warn "for publicationyear, I add $tag / $subfield".$record->field($tag)->subfield($subfield);
2921 ($tag,$subfield) = MARCfind_marc_from_kohafield($dbh,"biblioitems.size","");
2922 if ($record->field($tag)) {
2923 if ($record->field($tag)->subfields($subfield)) {
2924 push @tags, "'".$tag.$subfield."'";
2925 push @and_or, "and";
2926 push @excluding, "";
2927 push @operator, "=";
2928 push @value, $record->field($tag)->subfield($subfield);
2929 # warn "for size, I add $tag / $subfield".$record->field($tag)->subfield($subfield);
2932 # ... and on publisher.
2933 ($tag,$subfield) = MARCfind_marc_from_kohafield($dbh,"biblioitems.publishercode","");
2934 if ($record->field($tag)) {
2935 if ($record->field($tag)->subfields($subfield)) {
2936 push @tags, "'".$tag.$subfield."'";
2937 push @and_or, "and";
2938 push @excluding, "";
2939 push @operator, "=";
2940 push @value, $record->field($tag)->subfield($subfield);
2941 # warn "for publishercode, I add $tag / $subfield".$record->field($tag)->subfield($subfield);
2944 # ... and on volume.
2945 ($tag,$subfield) = MARCfind_marc_from_kohafield($dbh,"biblioitems.volume","");
2946 if ($record->field($tag)) {
2947 if ($record->field($tag)->subfields($subfield)) {
2948 push @tags, "'".$tag.$subfield."'";
2949 push @and_or, "and";
2950 push @excluding, "";
2951 push @operator, "=";
2952 push @value, $record->field($tag)->subfield($subfield);
2953 # warn "for volume, I add $tag / $subfield".$record->field($tag)->subfield($subfield);
2957 my ($finalresult,$nbresult) = C4::SearchMarc::catalogsearch($dbh,\@tags,\@and_or,\@excluding,\@operator,\@value,0,10);
2958 # there is at least 1 result => return the 1st one
2960 # warn "$nbresult => ".@$finalresult[0]->{biblionumber},@$finalresult[0]->{bibid},@$finalresult[0]->{title};
2961 return @$finalresult[0]->{biblionumber},@$finalresult[0]->{bibid},@$finalresult[0]->{title};
2963 # no result, returns nothing
2970 if(substr($isbn, 0, 1) <=7) {
2971 $seg1 = substr($isbn, 0, 1);
2972 } elsif(substr($isbn, 0, 2) <= 94) {
2973 $seg1 = substr($isbn, 0, 2);
2974 } elsif(substr($isbn, 0, 3) <= 995) {
2975 $seg1 = substr($isbn, 0, 3);
2976 } elsif(substr($isbn, 0, 4) <= 9989) {
2977 $seg1 = substr($isbn, 0, 4);
2979 $seg1 = substr($isbn, 0, 5);
2981 my $x = substr($isbn, length($seg1));
2983 if(substr($x, 0, 2) <= 19) {
2984 # if(sTmp2 < 10) sTmp2 = "0" sTmp2;
2985 $seg2 = substr($x, 0, 2);
2986 } elsif(substr($x, 0, 3) <= 699) {
2987 $seg2 = substr($x, 0, 3);
2988 } elsif(substr($x, 0, 4) <= 8399) {
2989 $seg2 = substr($x, 0, 4);
2990 } elsif(substr($x, 0, 5) <= 89999) {
2991 $seg2 = substr($x, 0, 5);
2992 } elsif(substr($x, 0, 6) <= 9499999) {
2993 $seg2 = substr($x, 0, 6);
2995 $seg2 = substr($x, 0, 7);
2997 my $seg3=substr($x,length($seg2));
2998 $seg3=substr($seg3,0,length($seg3)-1) ;
2999 my $seg4 = substr($x, -1, 1);
3000 return "$seg1-$seg2-$seg3-$seg4";
3004 END { } # module clean-up code here (global destructor)
3010 Koha Developement team <info@koha.org>
3012 Paul POULAIN paul.poulain@free.fr
3018 # Revision 1.143 2006/02/20 13:26:11 kados
3019 # A new subroutine to handle Z39.50 extended services. You pass it a
3020 # connection object, service type, service options, and a record, and
3021 # it performs the service and handles any exception found.
3023 # Revision 1.142 2006/02/16 20:49:56 kados
3024 # destroy a connection after we're done -- we really should just have one
3025 # connection object and not destroy it until the whole transaction is
3026 # finished -- but this will do for now
3028 # Revision 1.141 2006/02/16 19:47:22 rangi
3029 # Trying to error trap a little more.
3031 # Revision 1.140 2006/02/14 21:36:03 kados
3032 # adding a 'use ZOOM' to biblio.pm, needed for non-mod_perl install.
3033 # also adding diagnostic error if not able to connect to Zebra
3035 # Revision 1.139 2006/02/14 19:53:25 rangi
3036 # Just a little missing my
3038 # Seems to be working great Paul, and I like what you did with zebradb
3040 # Revision 1.138 2006/02/14 11:25:22 tipaul
3041 # road to 3.0 : updating a biblio in zebra seems to work. Still working on it, there are probably some bugs !
3043 # Revision 1.137 2006/02/13 16:34:26 tipaul
3044 # fixing some warnings (perl -w should be quiet)
3046 # Revision 1.136 2006/01/10 17:01:29 tipaul
3047 # adding a XMLgetbiblio in Biblio.pm (1st draft, to use with zebra)
3049 # Revision 1.135 2006/01/06 16:39:37 tipaul
3050 # synch'ing head and rel_2_2 (from 2.2.5, including npl templates)
3051 # Seems not to break too many things, but i'm probably wrong here.
3052 # at least, new features/bugfixes from 2.2.5 are here (tested on some features on my head local copy)
3054 # - removing useless directories (koha-html and koha-plucene)
3056 # Revision 1.134 2006/01/04 15:54:55 tipaul
3057 # utf8 is a : go for beta test in HEAD.
3058 # some explanations :
3059 # - 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.
3060 # - *-top.inc will show the pages in utf8
3061 # - 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.
3062 # - using marcxml field and no more the iso2709 raw marc biblioitems.marc field.
3064 # Revision 1.133 2005/12/12 14:25:51 thd
3067 # Reverse array filled with elements from repeated subfields
3068 # to avoid last to first concatenation of elements in Koha DB.-
3070 # Revision 1.132 2005-10-26 09:12:33 tipaul
3071 # big commit, still breaking things...
3073 # * synch with rel_2_2. Probably the last non manual synch, as rel_2_2 should not be modified deeply.
3074 # * code cleaning (cleaning warnings from perl -w) continued
3076 # Revision 1.131 2005/09/22 10:01:45 tipaul
3077 # see mail on koha-devel : code cleaning on Search.pm + normalizing API + use of biblionumber everywhere (instead of bn, biblio, ...)
3079 # Revision 1.130 2005/09/02 14:34:14 tipaul
3080 # continuing the work to move to zebra. Begin of work for MARC=OFF support.
3081 # IMPORTANT NOTE : the MARCkoha2marc sub API has been modified. Instead of biblionumber & biblioitemnumber, it now gets a hash.
3082 # The sub is used only in Biblio.pm, so the API change should be harmless (except for me, but i'm aware ;-) )
3084 # Revision 1.129 2005/08/12 13:50:31 tipaul
3085 # removing useless sub declarations
3087 # Revision 1.128 2005/08/11 16:12:47 tipaul
3088 # Playing with the zebra...
3090 # * go to koha cvs home directory
3091 # * in misc/zebra there is a unimarc directory. I suggest that marc21 libraries create a marc21 directory
3092 # * put your zebra.cfg files here & create your database.
3093 # * from koha cvs home directory, ln -s misc/zebra/marc21 zebra (I mean create a symbolic link to YOUR zebra directory)
3094 # * now, everytime you add/modify a biblio/item your zebra DB is updated correctly.
3097 # * this uses a system call in perl. CPU consumming, but we are waiting for indexdata Perl/zoom
3098 # * deletion still not work
3099 # * UNIMARC zebra config files are provided in misc/zebra/unimarc directory. The most important line being :
3101 # recordId: (bib1,Local-number)
3105 # elm 090 Local-number -
3106 # elm 090/? Local-number -
3107 # elm 090/?/9 Local-number !:w
3109 # (090$9 being the field mapped to biblio.biblionumber in Koha)
3111 # Revision 1.127 2005/08/11 14:37:32 tipaul
3113 # * removing useless subs
3114 # * removing some subs that are also elsewhere
3115 # * 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)
3117 # Revision 1.126 2005/08/11 09:13:28 tipaul
3118 # just removing useless subs (a lot !!!) for code cleaning
3120 # Revision 1.125 2005/08/11 09:00:07 tipaul
3121 # Ok guys, this time, it seems that item add and modif begin working as expected...
3122 # Still a lot of bugs to fix, of course
3124 # Revision 1.124 2005/08/10 10:21:15 tipaul
3125 # continuing the road to zebra :
3126 # - the biblio add begins to work.
3127 # - the biblio modif begins to work.
3129 # (still without doing anything on zebra)
3130 # (no new change in updatedatabase)
3132 # Revision 1.123 2005/08/09 14:10:28 tipaul
3133 # 1st commit to go to zebra.
3134 # don't update your cvs if you want to have a working head...
3136 # this commit contains :
3137 # * 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...
3138 # * 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.
3139 # * other files : get rid of bibid and use biblionumber instead.
3142 # * does not do anything on zebra yet.
3143 # * if you rename marc_subfield_table, you can't search anymore.
3144 # * you can view a biblio & bibliodetails, go to MARC editor, but NOT save any modif.
3145 # * 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 ;-) )
3147 # 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
3148 # 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.
3150 # tipaul cutted previous commit notes