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
17 # with Koha; if not, write to the Free Software Foundation, Inc.,
18 # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
25 use MARC::File::USMARC;
28 use POSIX qw(strftime);
31 use C4::Dates qw/format_date/;
32 use C4::Log; # logaction
38 use vars qw($VERSION @ISA @EXPORT);
44 @ISA = qw( Exporter );
59 &GetBiblioItemByBiblioNumber
60 &GetBiblioFromItemNumber
61 &GetBiblionumberFromItemnumber
80 &GetAuthorisedValueDesc
84 &GetPublisherNameFromIsbn
102 # To link headings in a bib record
103 # to authority records.
105 &LinkBibHeadingsToAuthorities
109 # those functions are exported but should not be used
110 # they are usefull is few circumstances, so are exported.
111 # but don't use them unless you're a core developer ;-)
119 &TransformHtmlToMarc2
122 &PrepareItemrecordDisplay
128 my $servers = C4::Context->config('memcached_servers');
130 require Memoize::Memcached;
131 import Memoize::Memcached qw(memoize_memcached);
134 servers => [$servers],
135 key_prefix => C4::Context->config('memcached_namespace') || 'koha',
137 memoize_memcached( 'GetMarcStructure', memcached => $memcached, expire_time => 600 ); #cache for 10 minutes
143 C4::Biblio - cataloging management functions
147 Biblio.pm contains functions for managing storage and editing of bibliographic data within Koha. Most of the functions in this module are used for cataloging records: adding, editing, or removing biblios, biblioitems, or items. Koha's stores bibliographic information in three places:
151 =item 1. in the biblio,biblioitems,items, etc tables, which are limited to a one-to-one mapping to underlying MARC data
153 =item 2. as raw MARC in the Zebra index and storage engine
155 =item 3. as raw MARC the biblioitems.marc and biblioitems.marcxml
159 In the 3.0 version of Koha, the authoritative record-level information is in biblioitems.marcxml
161 Because the data isn't completely normalized there's a chance for information to get out of sync. The design choice to go with a un-normalized schema was driven by performance and stability concerns. However, if this occur, it can be considered as a bug : The API is (or should be) complete & the only entry point for all biblio/items managements.
165 =item 1. Compared with MySQL, Zebra is slow to update an index for small data changes -- especially for proc-intensive operations like circulation
167 =item 2. Zebra's index has been known to crash and a backup of the data is necessary to rebuild it in such cases
171 Because of this design choice, the process of managing storage and editing is a bit convoluted. Historically, Biblio.pm's grown to an unmanagable size and as a result we have several types of functions currently:
175 =item 1. Add*/Mod*/Del*/ - high-level external functions suitable for being called from external scripts to manage the collection
177 =item 2. _koha_* - low-level internal functions for managing the koha tables
179 =item 3. Marc management function : as the MARC record is stored in biblioitems.marc(xml), some subs dedicated to it's management are in this package. They should be used only internally by Biblio.pm, the only official entry points being AddBiblio, AddItem, ModBiblio, ModItem.
181 =item 4. Zebra functions used to update the Zebra index
183 =item 5. internal helper functions such as char_decode, checkitems, etc. Some of these probably belong in Koha.pm
187 The MARC record (in biblioitems.marcxml) contains the complete marc record, including items. It also contains the biblionumber. That is the reason why it is not stored directly by AddBiblio, with all other fields . To save a biblio, we need to :
191 =item 1. save datas in biblio and biblioitems table, that gives us a biblionumber and a biblioitemnumber
193 =item 2. add the biblionumber and biblioitemnumber into the MARC records
195 =item 3. save the marc record
199 When dealing with items, we must :
203 =item 1. save the item in items table, that gives us an itemnumber
205 =item 2. add the itemnumber to the item MARC field
207 =item 3. overwrite the MARC record (with the added item) into biblioitems.marc(xml)
209 When modifying a biblio or an item, the behaviour is quite similar.
213 =head1 EXPORTED FUNCTIONS
217 ($biblionumber,$biblioitemnumber) = AddBiblio($record,$frameworkcode);
219 Exported function (core API) for adding a new biblio to koha.
221 The first argument is a C<MARC::Record> object containing the
222 bib to add, while the second argument is the desired MARC
225 This function also accepts a third, optional argument: a hashref
226 to additional options. The only defined option is C<defer_marc_save>,
227 which if present and mapped to a true value, causes C<AddBiblio>
228 to omit the call to save the MARC in C<bibilioitems.marc>
229 and C<biblioitems.marcxml> This option is provided B<only>
230 for the use of scripts such as C<bulkmarcimport.pl> that may need
231 to do some manipulation of the MARC record for item parsing before
232 saving it and which cannot afford the performance hit of saving
233 the MARC record twice. Consequently, do not use that option
234 unless you can guarantee that C<ModBiblioMarc> will be called.
240 my $frameworkcode = shift;
241 my $options = @_ ? shift : undef;
242 my $defer_marc_save = 0;
243 if ( defined $options and exists $options->{'defer_marc_save'} and $options->{'defer_marc_save'} ) {
244 $defer_marc_save = 1;
247 my ( $biblionumber, $biblioitemnumber, $error );
248 my $dbh = C4::Context->dbh;
250 # transform the data into koha-table style data
251 my $olddata = TransformMarcToKoha( $dbh, $record, $frameworkcode );
252 ( $biblionumber, $error ) = _koha_add_biblio( $dbh, $olddata, $frameworkcode );
253 $olddata->{'biblionumber'} = $biblionumber;
254 ( $biblioitemnumber, $error ) = _koha_add_biblioitem( $dbh, $olddata );
256 _koha_marc_update_bib_ids( $record, $frameworkcode, $biblionumber, $biblioitemnumber );
258 # update MARC subfield that stores biblioitems.cn_sort
259 _koha_marc_update_biblioitem_cn_sort( $record, $olddata, $frameworkcode );
262 ModBiblioMarc( $record, $biblionumber, $frameworkcode ) unless $defer_marc_save;
264 logaction( "CATALOGUING", "ADD", $biblionumber, "biblio" ) if C4::Context->preference("CataloguingLog");
265 return ( $biblionumber, $biblioitemnumber );
270 ModBiblio( $record,$biblionumber,$frameworkcode);
272 Replace an existing bib record identified by C<$biblionumber>
273 with one supplied by the MARC::Record object C<$record>. The embedded
274 item, biblioitem, and biblionumber fields from the previous
275 version of the bib record replace any such fields of those tags that
276 are present in C<$record>. Consequently, ModBiblio() is not
277 to be used to try to modify item records.
279 C<$frameworkcode> specifies the MARC framework to use
280 when storing the modified bib record; among other things,
281 this controls how MARC fields get mapped to display columns
282 in the C<biblio> and C<biblioitems> tables, as well as
283 which fields are used to store embedded item, biblioitem,
284 and biblionumber data for indexing.
289 my ( $record, $biblionumber, $frameworkcode ) = @_;
290 if ( C4::Context->preference("CataloguingLog") ) {
291 my $newrecord = GetMarcBiblio($biblionumber);
292 logaction( "CATALOGUING", "MODIFY", $biblionumber, "BEFORE=>" . $newrecord->as_formatted );
295 my $dbh = C4::Context->dbh;
297 $frameworkcode = "" unless $frameworkcode;
299 # get the items before and append them to the biblio before updating the record, atm we just have the biblio
300 my ( $itemtag, $itemsubfield ) = GetMarcFromKohaField( "items.itemnumber", $frameworkcode );
301 my $oldRecord = GetMarcBiblio($biblionumber);
303 # delete any item fields from incoming record to avoid
304 # duplication or incorrect data - use AddItem() or ModItem()
306 foreach my $field ( $record->field($itemtag) ) {
307 $record->delete_field($field);
310 # parse each item, and, for an unknown reason, re-encode each subfield
311 # if you don't do that, the record will have encoding mixed
312 # and the biblio will be re-encoded.
313 # strange, I (Paul P.) searched more than 1 day to understand what happends
314 # but could only solve the problem this way...
315 my @fields = $oldRecord->field($itemtag);
316 foreach my $fielditem (@fields) {
318 foreach ( $fielditem->subfields() ) {
320 $field->add_subfields( Encode::encode( 'utf-8', $_->[0] ) => Encode::encode( 'utf-8', $_->[1] ) );
322 $field = MARC::Field->new( "$itemtag", '', '', Encode::encode( 'utf-8', $_->[0] ) => Encode::encode( 'utf-8', $_->[1] ) );
325 $record->append_fields($field);
328 # update biblionumber and biblioitemnumber in MARC
329 # FIXME - this is assuming a 1 to 1 relationship between
330 # biblios and biblioitems
331 my $sth = $dbh->prepare("select biblioitemnumber from biblioitems where biblionumber=?");
332 $sth->execute($biblionumber);
333 my ($biblioitemnumber) = $sth->fetchrow;
335 _koha_marc_update_bib_ids( $record, $frameworkcode, $biblionumber, $biblioitemnumber );
337 # load the koha-table data object
338 my $oldbiblio = TransformMarcToKoha( $dbh, $record, $frameworkcode );
340 # update MARC subfield that stores biblioitems.cn_sort
341 _koha_marc_update_biblioitem_cn_sort( $record, $oldbiblio, $frameworkcode );
343 # update the MARC record (that now contains biblio and items) with the new record data
344 &ModBiblioMarc( $record, $biblionumber, $frameworkcode );
346 # modify the other koha tables
347 _koha_modify_biblio( $dbh, $oldbiblio, $frameworkcode );
348 _koha_modify_biblioitem_nonmarc( $dbh, $oldbiblio );
352 =head2 ModBiblioframework
354 ModBiblioframework($biblionumber,$frameworkcode);
356 Exported function to modify a biblio framework
360 sub ModBiblioframework {
361 my ( $biblionumber, $frameworkcode ) = @_;
362 my $dbh = C4::Context->dbh;
363 my $sth = $dbh->prepare( "UPDATE biblio SET frameworkcode=? WHERE biblionumber=?" );
364 $sth->execute( $frameworkcode, $biblionumber );
370 my $error = &DelBiblio($dbh,$biblionumber);
372 Exported function (core API) for deleting a biblio in koha.
373 Deletes biblio record from Zebra and Koha tables (biblio,biblioitems,items)
374 Also backs it up to deleted* tables
375 Checks to make sure there are not issues on any of the items
377 C<$error> : undef unless an error occurs
382 my ($biblionumber) = @_;
383 my $dbh = C4::Context->dbh;
384 my $error; # for error handling
386 # First make sure this biblio has no items attached
387 my $sth = $dbh->prepare("SELECT itemnumber FROM items WHERE biblionumber=?");
388 $sth->execute($biblionumber);
389 if ( my $itemnumber = $sth->fetchrow ) {
391 # Fix this to use a status the template can understand
392 $error .= "This Biblio has items attached, please delete them first before deleting this biblio ";
395 return $error if $error;
397 # We delete attached subscriptions
398 my $subscriptions = &C4::Serials::GetFullSubscriptionsFromBiblionumber($biblionumber);
399 foreach my $subscription (@$subscriptions) {
400 &C4::Serials::DelSubscription( $subscription->{subscriptionid} );
403 # Delete in Zebra. Be careful NOT to move this line after _koha_delete_biblio
404 # for at least 2 reasons :
405 # - we need to read the biblio if NoZebra is set (to remove it from the indexes
406 # - if something goes wrong, the biblio may be deleted from Koha but not from zebra
407 # and we would have no way to remove it (except manually in zebra, but I bet it would be very hard to handle the problem)
409 if ( C4::Context->preference("NoZebra") ) {
411 # only NoZebra indexing needs to have
412 # the previous version of the record
413 $oldRecord = GetMarcBiblio($biblionumber);
415 ModZebra( $biblionumber, "recordDelete", "biblioserver", $oldRecord, undef );
417 # delete biblioitems and items from Koha tables and save in deletedbiblioitems,deleteditems
418 $sth = $dbh->prepare("SELECT biblioitemnumber FROM biblioitems WHERE biblionumber=?");
419 $sth->execute($biblionumber);
420 while ( my $biblioitemnumber = $sth->fetchrow ) {
422 # delete this biblioitem
423 $error = _koha_delete_biblioitems( $dbh, $biblioitemnumber );
424 return $error if $error;
427 # delete biblio from Koha tables and save in deletedbiblio
428 # must do this *after* _koha_delete_biblioitems, otherwise
429 # delete cascade will prevent deletedbiblioitems rows
430 # from being generated by _koha_delete_biblioitems
431 $error = _koha_delete_biblio( $dbh, $biblionumber );
433 logaction( "CATALOGUING", "DELETE", $biblionumber, "" ) if C4::Context->preference("CataloguingLog");
438 =head2 LinkBibHeadingsToAuthorities
440 my $headings_linked = LinkBibHeadingsToAuthorities($marc);
442 Links bib headings to authority records by checking
443 each authority-controlled field in the C<MARC::Record>
444 object C<$marc>, looking for a matching authority record,
445 and setting the linking subfield $9 to the ID of that
448 If no matching authority exists, or if multiple
449 authorities match, no $9 will be added, and any
450 existing one inthe field will be deleted.
452 Returns the number of heading links changed in the
457 sub LinkBibHeadingsToAuthorities {
460 my $num_headings_changed = 0;
461 foreach my $field ( $bib->fields() ) {
462 my $heading = C4::Heading->new_from_bib_field($field);
463 next unless defined $heading;
466 my $current_link = $field->subfield('9');
468 # look for matching authorities
469 my $authorities = $heading->authorities();
471 # want only one exact match
472 if ( $#{$authorities} == 0 ) {
473 my $authority = MARC::Record->new_from_usmarc( $authorities->[0] );
474 my $authid = $authority->field('001')->data();
475 next if defined $current_link and $current_link eq $authid;
477 $field->delete_subfield( code => '9' ) if defined $current_link;
478 $field->add_subfields( '9', $authid );
479 $num_headings_changed++;
481 if ( defined $current_link ) {
482 $field->delete_subfield( code => '9' );
483 $num_headings_changed++;
488 return $num_headings_changed;
491 =head2 GetRecordValue
493 my $values = GetRecordValue($field, $record, $frameworkcode);
495 Get MARC fields from a keyword defined in fieldmapping table.
500 my ( $field, $record, $frameworkcode ) = @_;
501 my $dbh = C4::Context->dbh;
503 my $sth = $dbh->prepare('SELECT fieldcode, subfieldcode FROM fieldmapping WHERE frameworkcode = ? AND field = ?');
504 $sth->execute( $frameworkcode, $field );
508 while ( my $row = $sth->fetchrow_hashref ) {
509 foreach my $field ( $record->field( $row->{fieldcode} ) ) {
510 if ( ( $row->{subfieldcode} ne "" && $field->subfield( $row->{subfieldcode} ) ) ) {
511 foreach my $subfield ( $field->subfield( $row->{subfieldcode} ) ) {
512 push @result, { 'subfield' => $subfield };
515 } elsif ( $row->{subfieldcode} eq "" ) {
516 push @result, { 'subfield' => $field->as_string() };
524 =head2 SetFieldMapping
526 SetFieldMapping($framework, $field, $fieldcode, $subfieldcode);
528 Set a Field to MARC mapping value, if it already exists we don't add a new one.
532 sub SetFieldMapping {
533 my ( $framework, $field, $fieldcode, $subfieldcode ) = @_;
534 my $dbh = C4::Context->dbh;
536 my $sth = $dbh->prepare('SELECT * FROM fieldmapping WHERE fieldcode = ? AND subfieldcode = ? AND frameworkcode = ? AND field = ?');
537 $sth->execute( $fieldcode, $subfieldcode, $framework, $field );
538 if ( not $sth->fetchrow_hashref ) {
540 $sth = $dbh->prepare('INSERT INTO fieldmapping (fieldcode, subfieldcode, frameworkcode, field) VALUES(?,?,?,?)');
542 $sth->execute( $fieldcode, $subfieldcode, $framework, $field );
546 =head2 DeleteFieldMapping
548 DeleteFieldMapping($id);
550 Delete a field mapping from an $id.
554 sub DeleteFieldMapping {
556 my $dbh = C4::Context->dbh;
558 my $sth = $dbh->prepare('DELETE FROM fieldmapping WHERE id = ?');
562 =head2 GetFieldMapping
564 GetFieldMapping($frameworkcode);
566 Get all field mappings for a specified frameworkcode
570 sub GetFieldMapping {
571 my ($framework) = @_;
572 my $dbh = C4::Context->dbh;
574 my $sth = $dbh->prepare('SELECT * FROM fieldmapping where frameworkcode = ?');
575 $sth->execute($framework);
578 while ( my $row = $sth->fetchrow_hashref ) {
586 $data = &GetBiblioData($biblionumber);
588 Returns information about the book with the given biblionumber.
589 C<&GetBiblioData> returns a reference-to-hash. The keys are the fields in
590 the C<biblio> and C<biblioitems> tables in the
593 In addition, C<$data-E<gt>{subject}> is the list of the book's
594 subjects, separated by C<" , "> (space, comma, space).
595 If there are multiple biblioitems with the given biblionumber, only
596 the first one is considered.
602 my $dbh = C4::Context->dbh;
604 # my $query = C4::Context->preference('item-level_itypes') ?
605 # " SELECT * , biblioitems.notes AS bnotes, biblio.notes
607 # LEFT JOIN biblioitems ON biblio.biblionumber = biblioitems.biblionumber
608 # WHERE biblio.biblionumber = ?
609 # AND biblioitems.biblionumber = biblio.biblionumber
612 my $query = " SELECT * , biblioitems.notes AS bnotes, itemtypes.notforloan as bi_notforloan, biblio.notes
614 LEFT JOIN biblioitems ON biblio.biblionumber = biblioitems.biblionumber
615 LEFT JOIN itemtypes ON biblioitems.itemtype = itemtypes.itemtype
616 WHERE biblio.biblionumber = ?
617 AND biblioitems.biblionumber = biblio.biblionumber ";
619 my $sth = $dbh->prepare($query);
620 $sth->execute($bibnum);
622 $data = $sth->fetchrow_hashref;
626 } # sub GetBiblioData
628 =head2 &GetBiblioItemData
630 $itemdata = &GetBiblioItemData($biblioitemnumber);
632 Looks up the biblioitem with the given biblioitemnumber. Returns a
633 reference-to-hash. The keys are the fields from the C<biblio>,
634 C<biblioitems>, and C<itemtypes> tables in the Koha database, except
635 that C<biblioitems.notes> is given as C<$itemdata-E<gt>{bnotes}>.
640 sub GetBiblioItemData {
641 my ($biblioitemnumber) = @_;
642 my $dbh = C4::Context->dbh;
643 my $query = "SELECT *,biblioitems.notes AS bnotes
644 FROM biblio LEFT JOIN biblioitems on biblio.biblionumber=biblioitems.biblionumber ";
645 unless ( C4::Context->preference('item-level_itypes') ) {
646 $query .= "LEFT JOIN itemtypes on biblioitems.itemtype=itemtypes.itemtype ";
648 $query .= " WHERE biblioitemnumber = ? ";
649 my $sth = $dbh->prepare($query);
651 $sth->execute($biblioitemnumber);
652 $data = $sth->fetchrow_hashref;
655 } # sub &GetBiblioItemData
657 =head2 GetBiblioItemByBiblioNumber
659 NOTE : This function has been copy/paste from C4/Biblio.pm from head before zebra integration.
663 sub GetBiblioItemByBiblioNumber {
664 my ($biblionumber) = @_;
665 my $dbh = C4::Context->dbh;
666 my $sth = $dbh->prepare("Select * FROM biblioitems WHERE biblionumber = ?");
670 $sth->execute($biblionumber);
672 while ( my $data = $sth->fetchrow_hashref ) {
673 push @results, $data;
680 =head2 GetBiblionumberFromItemnumber
685 sub GetBiblionumberFromItemnumber {
686 my ($itemnumber) = @_;
687 my $dbh = C4::Context->dbh;
688 my $sth = $dbh->prepare("Select biblionumber FROM items WHERE itemnumber = ?");
690 $sth->execute($itemnumber);
691 my ($result) = $sth->fetchrow;
695 =head2 GetBiblioFromItemNumber
697 $item = &GetBiblioFromItemNumber($itemnumber,$barcode);
699 Looks up the item with the given itemnumber. if undef, try the barcode.
701 C<&itemnodata> returns a reference-to-hash whose keys are the fields
702 from the C<biblio>, C<biblioitems>, and C<items> tables in the Koha
708 sub GetBiblioFromItemNumber {
709 my ( $itemnumber, $barcode ) = @_;
710 my $dbh = C4::Context->dbh;
713 $sth = $dbh->prepare(
715 LEFT JOIN biblio ON biblio.biblionumber = items.biblionumber
716 LEFT JOIN biblioitems ON biblioitems.biblioitemnumber = items.biblioitemnumber
717 WHERE items.itemnumber = ?"
719 $sth->execute($itemnumber);
721 $sth = $dbh->prepare(
723 LEFT JOIN biblio ON biblio.biblionumber = items.biblionumber
724 LEFT JOIN biblioitems ON biblioitems.biblioitemnumber = items.biblioitemnumber
725 WHERE items.barcode = ?"
727 $sth->execute($barcode);
729 my $data = $sth->fetchrow_hashref;
736 $isbd = &GetISBDView($biblionumber);
738 Return the ISBD view which can be included in opac and intranet
743 my ( $biblionumber, $template ) = @_;
744 my $record = GetMarcBiblio($biblionumber);
745 my $itemtype = &GetFrameworkCode($biblionumber);
746 my ( $holdingbrtagf, $holdingbrtagsubf ) = &GetMarcFromKohaField( "items.holdingbranch", $itemtype );
747 my $tagslib = &GetMarcStructure( 1, $itemtype );
749 my $ISBD = C4::Context->preference('ISBD');
754 foreach my $isbdfield ( split( /#/, $bloc ) ) {
756 # $isbdfield= /(.?.?.?)/;
757 $isbdfield =~ /(\d\d\d)([^\|])?\|(.*)\|(.*)\|(.*)/;
758 my $fieldvalue = $1 || 0;
759 my $subfvalue = $2 || "";
761 my $analysestring = $4;
764 # warn "==> $1 / $2 / $3 / $4";
765 # my $fieldvalue=substr($isbdfield,0,3);
766 if ( $fieldvalue > 0 ) {
767 my $hasputtextbefore = 0;
768 my @fieldslist = $record->field($fieldvalue);
769 @fieldslist = sort { $a->subfield($holdingbrtagsubf) cmp $b->subfield($holdingbrtagsubf) } @fieldslist if ( $fieldvalue eq $holdingbrtagf );
771 # warn "ERROR IN ISBD DEFINITION at : $isbdfield" unless $fieldvalue;
772 # warn "FV : $fieldvalue";
773 if ( $subfvalue ne "" ) {
774 foreach my $field (@fieldslist) {
775 foreach my $subfield ( $field->subfield($subfvalue) ) {
776 my $calculated = $analysestring;
777 my $tag = $field->tag();
780 my $subfieldvalue = GetAuthorisedValueDesc( $tag, $subfvalue, $subfield, '', $tagslib );
781 my $tagsubf = $tag . $subfvalue;
782 $calculated =~ s/\{(.?.?.?.?)$tagsubf(.*?)\}/$1$subfieldvalue$2\{$1$tagsubf$2\}/g;
783 if ( $template eq "opac" ) { $calculated =~ s#/cgi-bin/koha/[^/]+/([^.]*.pl\?.*)$#opac-$1#g; }
785 # field builded, store the result
786 if ( $calculated && !$hasputtextbefore ) { # put textbefore if not done
787 $blocres .= $textbefore;
788 $hasputtextbefore = 1;
791 # remove punctuation at start
792 $calculated =~ s/^( |;|:|\.|-)*//g;
793 $blocres .= $calculated;
798 $blocres .= $textafter if $hasputtextbefore;
800 foreach my $field (@fieldslist) {
801 my $calculated = $analysestring;
802 my $tag = $field->tag();
805 my @subf = $field->subfields;
806 for my $i ( 0 .. $#subf ) {
807 my $valuecode = $subf[$i][1];
808 my $subfieldcode = $subf[$i][0];
809 my $subfieldvalue = GetAuthorisedValueDesc( $tag, $subf[$i][0], $subf[$i][1], '', $tagslib );
810 my $tagsubf = $tag . $subfieldcode;
812 $calculated =~ s/ # replace all {{}} codes by the value code.
813 \{\{$tagsubf\}\} # catch the {{actualcode}}
815 $valuecode # replace by the value code
818 $calculated =~ s/\{(.?.?.?.?)$tagsubf(.*?)\}/$1$subfieldvalue$2\{$1$tagsubf$2\}/g;
819 if ( $template eq "opac" ) { $calculated =~ s#/cgi-bin/koha/[^/]+/([^.]*.pl\?.*)$#opac-$1#g; }
822 # field builded, store the result
823 if ( $calculated && !$hasputtextbefore ) { # put textbefore if not done
824 $blocres .= $textbefore;
825 $hasputtextbefore = 1;
828 # remove punctuation at start
829 $calculated =~ s/^( |;|:|\.|-)*//g;
830 $blocres .= $calculated;
833 $blocres .= $textafter if $hasputtextbefore;
836 $blocres .= $isbdfield;
841 $res =~ s/\{(.*?)\}//g;
843 $res =~ s/\n/<br\/>/g;
853 ( $count, @results ) = &GetBiblio($biblionumber);
858 my ($biblionumber) = @_;
859 my $dbh = C4::Context->dbh;
860 my $sth = $dbh->prepare("SELECT * FROM biblio WHERE biblionumber = ?");
863 $sth->execute($biblionumber);
864 while ( my $data = $sth->fetchrow_hashref ) {
865 $results[$count] = $data;
869 return ( $count, @results );
872 =head2 GetBiblioItemInfosOf
874 GetBiblioItemInfosOf(@biblioitemnumbers);
878 sub GetBiblioItemInfosOf {
879 my @biblioitemnumbers = @_;
882 SELECT biblioitemnumber,
886 WHERE biblioitemnumber IN (' . join( ',', @biblioitemnumbers ) . ')
888 return get_infos_of( $query, 'biblioitemnumber' );
891 =head1 FUNCTIONS FOR HANDLING MARC MANAGEMENT
893 =head2 GetMarcStructure
895 $res = GetMarcStructure($forlibrarian,$frameworkcode);
897 Returns a reference to a big hash of hash, with the Marc structure for the given frameworkcode
898 $forlibrarian :if set to 1, the MARC descriptions are the librarians ones, otherwise it's the public (OPAC) ones
899 $frameworkcode : the framework code to read
903 # cache for results of GetMarcStructure -- needed
905 our $marc_structure_cache;
907 sub GetMarcStructure {
908 my ( $forlibrarian, $frameworkcode ) = @_;
909 my $dbh = C4::Context->dbh;
910 $frameworkcode = "" unless $frameworkcode;
912 if ( defined $marc_structure_cache and exists $marc_structure_cache->{$forlibrarian}->{$frameworkcode} ) {
913 return $marc_structure_cache->{$forlibrarian}->{$frameworkcode};
916 # my $sth = $dbh->prepare(
917 # "SELECT COUNT(*) FROM marc_tag_structure WHERE frameworkcode=?");
918 # $sth->execute($frameworkcode);
919 # my ($total) = $sth->fetchrow;
920 # $frameworkcode = "" unless ( $total > 0 );
921 my $sth = $dbh->prepare(
922 "SELECT tagfield,liblibrarian,libopac,mandatory,repeatable
923 FROM marc_tag_structure
924 WHERE frameworkcode=?
927 $sth->execute($frameworkcode);
928 my ( $liblibrarian, $libopac, $tag, $res, $tab, $mandatory, $repeatable );
930 while ( ( $tag, $liblibrarian, $libopac, $mandatory, $repeatable ) = $sth->fetchrow ) {
931 $res->{$tag}->{lib} = ( $forlibrarian or !$libopac ) ? $liblibrarian : $libopac;
932 $res->{$tag}->{tab} = "";
933 $res->{$tag}->{mandatory} = $mandatory;
934 $res->{$tag}->{repeatable} = $repeatable;
937 $sth = $dbh->prepare(
938 "SELECT tagfield,tagsubfield,liblibrarian,libopac,tab,mandatory,repeatable,authorised_value,authtypecode,value_builder,kohafield,seealso,hidden,isurl,link,defaultvalue
939 FROM marc_subfield_structure
940 WHERE frameworkcode=?
941 ORDER BY tagfield,tagsubfield
945 $sth->execute($frameworkcode);
948 my $authorised_value;
959 ( $tag, $subfield, $liblibrarian, $libopac, $tab, $mandatory, $repeatable, $authorised_value,
960 $authtypecode, $value_builder, $kohafield, $seealso, $hidden, $isurl, $link, $defaultvalue
964 $res->{$tag}->{$subfield}->{lib} = ( $forlibrarian or !$libopac ) ? $liblibrarian : $libopac;
965 $res->{$tag}->{$subfield}->{tab} = $tab;
966 $res->{$tag}->{$subfield}->{mandatory} = $mandatory;
967 $res->{$tag}->{$subfield}->{repeatable} = $repeatable;
968 $res->{$tag}->{$subfield}->{authorised_value} = $authorised_value;
969 $res->{$tag}->{$subfield}->{authtypecode} = $authtypecode;
970 $res->{$tag}->{$subfield}->{value_builder} = $value_builder;
971 $res->{$tag}->{$subfield}->{kohafield} = $kohafield;
972 $res->{$tag}->{$subfield}->{seealso} = $seealso;
973 $res->{$tag}->{$subfield}->{hidden} = $hidden;
974 $res->{$tag}->{$subfield}->{isurl} = $isurl;
975 $res->{$tag}->{$subfield}->{'link'} = $link;
976 $res->{$tag}->{$subfield}->{defaultvalue} = $defaultvalue;
979 $marc_structure_cache->{$forlibrarian}->{$frameworkcode} = $res;
984 =head2 GetUsedMarcStructure
986 The same function as GetMarcStructure except it just takes field
987 in tab 0-9. (used field)
989 my $results = GetUsedMarcStructure($frameworkcode);
991 C<$results> is a ref to an array which each case containts a ref
992 to a hash which each keys is the columns from marc_subfield_structure
994 C<$frameworkcode> is the framework code.
998 sub GetUsedMarcStructure($) {
999 my $frameworkcode = shift || '';
1002 FROM marc_subfield_structure
1004 AND frameworkcode = ?
1005 ORDER BY tagfield, tagsubfield
1007 my $sth = C4::Context->dbh->prepare($query);
1008 $sth->execute($frameworkcode);
1009 return $sth->fetchall_arrayref( {} );
1012 =head2 GetMarcFromKohaField
1014 ($MARCfield,$MARCsubfield)=GetMarcFromKohaField($kohafield,$frameworkcode);
1016 Returns the MARC fields & subfields mapped to the koha field
1017 for the given frameworkcode
1021 sub GetMarcFromKohaField {
1022 my ( $kohafield, $frameworkcode ) = @_;
1023 return 0, 0 unless $kohafield and defined $frameworkcode;
1024 my $relations = C4::Context->marcfromkohafield;
1025 return ( $relations->{$frameworkcode}->{$kohafield}->[0], $relations->{$frameworkcode}->{$kohafield}->[1] );
1028 =head2 GetMarcBiblio
1030 my $record = GetMarcBiblio($biblionumber);
1032 Returns MARC::Record representing bib identified by
1033 C<$biblionumber>. If no bib exists, returns undef.
1034 The MARC record contains both biblio & item data.
1039 my $biblionumber = shift;
1040 my $dbh = C4::Context->dbh;
1041 my $sth = $dbh->prepare("SELECT marcxml FROM biblioitems WHERE biblionumber=? ");
1042 $sth->execute($biblionumber);
1043 my $row = $sth->fetchrow_hashref;
1044 my $marcxml = StripNonXmlChars( $row->{'marcxml'} );
1045 MARC::File::XML->default_record_format( C4::Context->preference('marcflavour') );
1046 my $record = MARC::Record->new();
1049 $record = eval { MARC::Record::new_from_xml( $marcxml, "utf8", C4::Context->preference('marcflavour') ) };
1050 if ($@) { warn " problem with :$biblionumber : $@ \n$marcxml"; }
1052 # $record = MARC::Record::new_from_usmarc( $marc) if $marc;
1061 my $marcxml = GetXmlBiblio($biblionumber);
1063 Returns biblioitems.marcxml of the biblionumber passed in parameter.
1064 The XML contains both biblio & item datas
1069 my ($biblionumber) = @_;
1070 my $dbh = C4::Context->dbh;
1071 my $sth = $dbh->prepare("SELECT marcxml FROM biblioitems WHERE biblionumber=? ");
1072 $sth->execute($biblionumber);
1073 my ($marcxml) = $sth->fetchrow;
1077 =head2 GetCOinSBiblio
1079 my $coins = GetCOinSBiblio($biblionumber);
1081 Returns the COinS(a span) which can be included in a biblio record
1085 sub GetCOinSBiblio {
1086 my ($biblionumber) = @_;
1087 my $record = GetMarcBiblio($biblionumber);
1089 # get the coin format
1091 # can't get a valid MARC::Record object, bail out at this point
1092 warn "We called GetMarcBiblio with a biblionumber that doesn't exist biblionumber=$biblionumber";
1095 my $pos7 = substr $record->leader(), 7, 1;
1096 my $pos6 = substr $record->leader(), 6, 1;
1099 my ( $aulast, $aufirst ) = ( '', '' );
1108 if ( C4::Context->preference("marcflavour") eq "UNIMARC" ) {
1113 'b' => 'manuscript',
1115 'd' => 'manuscript',
1119 'i' => 'audioRecording',
1120 'j' => 'audioRecording',
1123 'm' => 'computerProgram',
1128 'a' => 'journalArticle',
1132 $genre = $fmts6->{$pos6} ? $fmts6->{$pos6} : 'book';
1134 if ( $genre eq 'book' ) {
1135 $genre = $fmts7->{$pos7} if $fmts7->{$pos7};
1138 ##### We must transform mtx to a valable mtx and document type ####
1139 if ( $genre eq 'book' ) {
1141 } elsif ( $genre eq 'journal' ) {
1143 } elsif ( $genre eq 'journalArticle' ) {
1150 $genre = ( $mtx eq 'dc' ) ? "&rft.type=$genre" : "&rft.genre=$genre";
1153 $aulast = $record->subfield( '700', 'a' );
1154 $aufirst = $record->subfield( '700', 'b' );
1155 $oauthors = "&rft.au=$aufirst $aulast";
1158 if ( $record->field('200') ) {
1159 for my $au ( $record->field('200')->subfield('g') ) {
1160 $oauthors .= "&rft.au=$au";
1165 ? "&rft.title=" . $record->subfield( '200', 'a' )
1166 : "&rft.title=" . $record->subfield( '200', 'a' ) . "&rft.btitle=" . $record->subfield( '200', 'a' );
1167 $pubyear = $record->subfield( '210', 'd' );
1168 $publisher = $record->subfield( '210', 'c' );
1169 $isbn = $record->subfield( '010', 'a' );
1170 $issn = $record->subfield( '011', 'a' );
1173 # MARC21 need some improve
1176 $genre = "&rft.genre=book";
1179 if ( $record->field('100') ) {
1180 $oauthors .= "&rft.au=" . $record->subfield( '100', 'a' );
1184 if ( $record->field('700') ) {
1185 for my $au ( $record->field('700')->subfield('a') ) {
1186 $oauthors .= "&rft.au=$au";
1189 $title = "&rft.btitle=" . $record->subfield( '245', 'a' );
1190 $subtitle = $record->subfield( '245', 'b' ) || '';
1191 $title .= $subtitle;
1192 $pubyear = $record->subfield( '260', 'c' ) || '';
1193 $publisher = $record->subfield( '260', 'b' ) || '';
1194 $isbn = $record->subfield( '020', 'a' ) || '';
1195 $issn = $record->subfield( '022', 'a' ) || '';
1199 "ctx_ver=Z39.88-2004&rft_val_fmt=info%3Aofi%2Ffmt%3Akev%3Amtx%3A$mtx$genre$title&rft.isbn=$isbn&rft.issn=$issn&rft.aulast=$aulast&rft.aufirst=$aufirst$oauthors&rft.pub=$publisher&rft.date=$pubyear";
1200 $coins_value =~ s/(\ |&[^a])/\+/g;
1201 $coins_value =~ s/\"/\"\;/g;
1203 #<!-- TMPL_VAR NAME="ocoins_format" -->&rft.au=<!-- TMPL_VAR NAME="author" -->&rft.btitle=<!-- TMPL_VAR NAME="title" -->&rft.date=<!-- TMPL_VAR NAME="publicationyear" -->&rft.pages=<!-- TMPL_VAR NAME="pages" -->&rft.isbn=<!-- TMPL_VAR NAME=amazonisbn -->&rft.aucorp=&rft.place=<!-- TMPL_VAR NAME="place" -->&rft.pub=<!-- TMPL_VAR NAME="publishercode" -->&rft.edition=<!-- TMPL_VAR NAME="edition" -->&rft.series=<!-- TMPL_VAR NAME="series" -->&rft.genre="
1205 return $coins_value;
1208 =head2 GetAuthorisedValueDesc
1210 my $subfieldvalue =get_authorised_value_desc(
1211 $tag, $subf[$i][0],$subf[$i][1], '', $taglib, $category, $opac);
1213 Retrieve the complete description for a given authorised value.
1215 Now takes $category and $value pair too.
1217 my $auth_value_desc =GetAuthorisedValueDesc(
1218 '','', 'DVD' ,'','','CCODE');
1220 If the optional $opac parameter is set to a true value, displays OPAC
1221 descriptions rather than normal ones when they exist.
1225 sub GetAuthorisedValueDesc {
1226 my ( $tag, $subfield, $value, $framework, $tagslib, $category, $opac ) = @_;
1227 my $dbh = C4::Context->dbh;
1231 return $value unless defined $tagslib->{$tag}->{$subfield}->{'authorised_value'};
1234 if ( $tagslib->{$tag}->{$subfield}->{'authorised_value'} eq "branches" ) {
1235 return C4::Branch::GetBranchName($value);
1239 if ( $tagslib->{$tag}->{$subfield}->{'authorised_value'} eq "itemtypes" ) {
1240 return getitemtypeinfo($value)->{description};
1243 #---- "true" authorized value
1244 $category = $tagslib->{$tag}->{$subfield}->{'authorised_value'};
1247 if ( $category ne "" ) {
1248 my $sth = $dbh->prepare( "SELECT lib, lib_opac FROM authorised_values WHERE category = ? AND authorised_value = ?" );
1249 $sth->execute( $category, $value );
1250 my $data = $sth->fetchrow_hashref;
1251 return ( $opac && $data->{'lib_opac'} ) ? $data->{'lib_opac'} : $data->{'lib'};
1253 return $value; # if nothing is found return the original value
1259 $marcnotesarray = GetMarcNotes( $record, $marcflavour );
1261 Get all notes from the MARC record and returns them in an array.
1262 The note are stored in differents places depending on MARC flavour
1267 my ( $record, $marcflavour ) = @_;
1269 if ( $marcflavour eq "MARC21" ) {
1271 } else { # assume unimarc if not marc21
1278 foreach my $field ( $record->field($scope) ) {
1279 my $value = $field->as_string();
1280 if ( $note ne "" ) {
1281 $marcnote = { marcnote => $note, };
1282 push @marcnotes, $marcnote;
1285 if ( $note ne $value ) {
1286 $note = $note . " " . $value;
1291 $marcnote = { marcnote => $note };
1292 push @marcnotes, $marcnote; #load last tag into array
1295 } # end GetMarcNotes
1297 =head2 GetMarcSubjects
1299 $marcsubjcts = GetMarcSubjects($record,$marcflavour);
1301 Get all subjects from the MARC record and returns them in an array.
1302 The subjects are stored in differents places depending on MARC flavour
1306 sub GetMarcSubjects {
1307 my ( $record, $marcflavour ) = @_;
1308 my ( $mintag, $maxtag );
1309 if ( $marcflavour eq "MARC21" ) {
1312 } else { # assume unimarc if not marc21
1322 foreach my $field ( $record->field('6..') ) {
1323 next unless $field->tag() >= $mintag && $field->tag() <= $maxtag;
1325 my @subfields = $field->subfields();
1329 # if there is an authority link, build the link with an= subfield9
1331 for my $subject_subfield (@subfields) {
1333 # don't load unimarc subfields 3,4,5
1334 next if ( ( $marcflavour eq "UNIMARC" ) and ( $subject_subfield->[0] =~ /2|3|4|5/ ) );
1336 # don't load MARC21 subfields 2 (FIXME: any more subfields??)
1337 next if ( ( $marcflavour eq "MARC21" ) and ( $subject_subfield->[0] =~ /2/ ) );
1338 my $code = $subject_subfield->[0];
1339 my $value = $subject_subfield->[1];
1340 my $linkvalue = $value;
1341 $linkvalue =~ s/(\(|\))//g;
1342 my $operator = " and " unless $counter == 0;
1345 @link_loop = ( { 'limit' => 'an', link => "$linkvalue" } );
1347 if ( not $found9 ) {
1348 push @link_loop, { 'limit' => 'su', link => $linkvalue, operator => $operator };
1350 my $separator = C4::Context->preference("authoritysep") unless $counter == 0;
1353 my @this_link_loop = @link_loop;
1354 push @subfields_loop, { code => $code, value => $value, link_loop => \@this_link_loop, separator => $separator } unless ( $subject_subfield->[0] eq 9 );
1358 push @marcsubjects, { MARCSUBJECT_SUBFIELDS_LOOP => \@subfields_loop };
1361 return \@marcsubjects;
1362 } #end getMARCsubjects
1364 =head2 GetMarcAuthors
1366 authors = GetMarcAuthors($record,$marcflavour);
1368 Get all authors from the MARC record and returns them in an array.
1369 The authors are stored in differents places depending on MARC flavour
1373 sub GetMarcAuthors {
1374 my ( $record, $marcflavour ) = @_;
1375 my ( $mintag, $maxtag );
1377 # tagslib useful for UNIMARC author reponsabilities
1379 &GetMarcStructure( 1, '' ); # FIXME : we don't have the framework available, we take the default framework. May be buggy on some setups, will be usually correct.
1380 if ( $marcflavour eq "MARC21" ) {
1383 } elsif ( $marcflavour eq "UNIMARC" ) { # assume unimarc if not marc21
1391 foreach my $field ( $record->fields ) {
1392 next unless $field->tag() >= $mintag && $field->tag() <= $maxtag;
1395 my @subfields = $field->subfields();
1398 # if there is an authority link, build the link with Koha-Auth-Number: subfield9
1399 my $subfield9 = $field->subfield('9');
1400 for my $authors_subfield (@subfields) {
1402 # don't load unimarc subfields 3, 5
1403 next if ( $marcflavour eq 'UNIMARC' and ( $authors_subfield->[0] =~ /3|5/ ) );
1404 my $subfieldcode = $authors_subfield->[0];
1405 my $value = $authors_subfield->[1];
1406 my $linkvalue = $value;
1407 $linkvalue =~ s/(\(|\))//g;
1408 my $operator = " and " unless $count_auth == 0;
1410 # if we have an authority link, use that as the link, otherwise use standard searching
1412 @link_loop = ( { 'limit' => 'an', link => "$subfield9" } );
1415 # reset $linkvalue if UNIMARC author responsibility
1416 if ( $marcflavour eq 'UNIMARC' and ( $authors_subfield->[0] eq "4" ) ) {
1417 $linkvalue = "(" . GetAuthorisedValueDesc( $field->tag(), $authors_subfield->[0], $authors_subfield->[1], '', $tagslib ) . ")";
1419 push @link_loop, { 'limit' => 'au', link => $linkvalue, operator => $operator };
1421 $value = GetAuthorisedValueDesc( $field->tag(), $authors_subfield->[0], $authors_subfield->[1], '', $tagslib )
1422 if ( $marcflavour eq 'UNIMARC' and ( $authors_subfield->[0] =~ /4/ ) );
1423 my @this_link_loop = @link_loop;
1424 my $separator = C4::Context->preference("authoritysep") unless $count_auth == 0;
1425 push @subfields_loop, { code => $subfieldcode, value => $value, link_loop => \@this_link_loop, separator => $separator } unless ( $authors_subfield->[0] eq '9' );
1428 push @marcauthors, { MARCAUTHOR_SUBFIELDS_LOOP => \@subfields_loop };
1430 return \@marcauthors;
1435 $marcurls = GetMarcUrls($record,$marcflavour);
1437 Returns arrayref of URLs from MARC data, suitable to pass to tmpl loop.
1438 Assumes web resources (not uncommon in MARC21 to omit resource type ind)
1443 my ( $record, $marcflavour ) = @_;
1446 for my $field ( $record->field('856') ) {
1448 for my $note ( $field->subfield('z') ) {
1449 push @notes, { note => $note };
1451 my @urls = $field->subfield('u');
1452 foreach my $url (@urls) {
1454 if ( $marcflavour eq 'MARC21' ) {
1455 my $s3 = $field->subfield('3');
1456 my $link = $field->subfield('y');
1457 unless ( $url =~ /^\w+:/ ) {
1458 if ( $field->indicator(1) eq '7' ) {
1459 $url = $field->subfield('2') . "://" . $url;
1460 } elsif ( $field->indicator(1) eq '1' ) {
1461 $url = 'ftp://' . $url;
1464 # properly, this should be if ind1=4,
1465 # however we will assume http protocol since we're building a link.
1466 $url = 'http://' . $url;
1470 # TODO handle ind 2 (relationship)
1475 $marcurl->{'linktext'} = $link || $s3 || C4::Context->preference('URLLinkText') || $url;
1476 $marcurl->{'part'} = $s3 if ($link);
1477 $marcurl->{'toc'} = 1 if ( defined($s3) && $s3 =~ /^[Tt]able/ );
1479 $marcurl->{'linktext'} = $field->subfield('2') || C4::Context->preference('URLLinkText') || $url;
1480 $marcurl->{'MARCURL'} = $url;
1482 push @marcurls, $marcurl;
1488 =head2 GetMarcSeries
1490 $marcseriesarray = GetMarcSeries($record,$marcflavour);
1492 Get all series from the MARC record and returns them in an array.
1493 The series are stored in differents places depending on MARC flavour
1498 my ( $record, $marcflavour ) = @_;
1499 my ( $mintag, $maxtag );
1500 if ( $marcflavour eq "MARC21" ) {
1503 } else { # assume unimarc if not marc21
1513 foreach my $field ( $record->field('440'), $record->field('490') ) {
1516 #my $value = $field->subfield('a');
1517 #$marcsubjct = {MARCSUBJCT => $value,};
1518 my @subfields = $field->subfields();
1520 #warn "subfields:".join " ", @$subfields;
1523 for my $series_subfield (@subfields) {
1525 undef $volume_number;
1527 # see if this is an instance of a volume
1528 if ( $series_subfield->[0] eq 'v' ) {
1532 my $code = $series_subfield->[0];
1533 my $value = $series_subfield->[1];
1534 my $linkvalue = $value;
1535 $linkvalue =~ s/(\(|\))//g;
1536 my $operator = " and " unless $counter == 0;
1537 push @link_loop, { link => $linkvalue, operator => $operator };
1538 my $separator = C4::Context->preference("authoritysep") unless $counter == 0;
1539 if ($volume_number) {
1540 push @subfields_loop, { volumenum => $value };
1542 push @subfields_loop, { code => $code, value => $value, link_loop => \@link_loop, separator => $separator, volumenum => $volume_number };
1546 push @marcseries, { MARCSERIES_SUBFIELDS_LOOP => \@subfields_loop };
1548 #$marcsubjct = {MARCSUBJCT => $field->as_string(),};
1549 #push @marcsubjcts, $marcsubjct;
1553 my $marcseriessarray = \@marcseries;
1554 return $marcseriessarray;
1555 } #end getMARCseriess
1557 =head2 GetFrameworkCode
1559 $frameworkcode = GetFrameworkCode( $biblionumber )
1563 sub GetFrameworkCode {
1564 my ($biblionumber) = @_;
1565 my $dbh = C4::Context->dbh;
1566 my $sth = $dbh->prepare("SELECT frameworkcode FROM biblio WHERE biblionumber=?");
1567 $sth->execute($biblionumber);
1568 my ($frameworkcode) = $sth->fetchrow;
1569 return $frameworkcode;
1572 =head2 GetPublisherNameFromIsbn
1574 $name = GetPublishercodeFromIsbn($isbn);
1581 sub GetPublisherNameFromIsbn($) {
1583 $isbn =~ s/[- _]//g;
1585 my @codes = ( split '-', DisplayISBN($isbn) );
1586 my $code = $codes[0] . $codes[1] . $codes[2];
1587 my $dbh = C4::Context->dbh;
1589 SELECT distinct publishercode
1592 AND publishercode IS NOT NULL
1595 my $sth = $dbh->prepare($query);
1596 $sth->execute("$code%");
1597 my $name = $sth->fetchrow;
1598 return $name if length $name;
1602 =head2 TransformKohaToMarc
1604 $record = TransformKohaToMarc( $hash )
1606 This function builds partial MARC::Record from a hash
1607 Hash entries can be from biblio or biblioitems.
1609 This function is called in acquisition module, to create a basic catalogue entry from user entry
1613 sub TransformKohaToMarc {
1615 my $sth = C4::Context->dbh->prepare( "SELECT tagfield,tagsubfield FROM marc_subfield_structure WHERE frameworkcode=? AND kohafield=?" );
1616 my $record = MARC::Record->new();
1617 SetMarcUnicodeFlag( $record, C4::Context->preference("marcflavour") );
1618 foreach ( keys %{$hash} ) {
1619 &TransformKohaToMarcOneField( $sth, $record, $_, $hash->{$_}, '' );
1624 =head2 TransformKohaToMarcOneField
1626 $record = TransformKohaToMarcOneField( $sth, $record, $kohafieldname, $value, $frameworkcode );
1630 sub TransformKohaToMarcOneField {
1631 my ( $sth, $record, $kohafieldname, $value, $frameworkcode ) = @_;
1632 $frameworkcode = '' unless $frameworkcode;
1636 if ( !defined $sth ) {
1637 my $dbh = C4::Context->dbh;
1638 $sth = $dbh->prepare( "SELECT tagfield,tagsubfield FROM marc_subfield_structure WHERE frameworkcode=? AND kohafield=?" );
1640 $sth->execute( $frameworkcode, $kohafieldname );
1641 if ( ( $tagfield, $tagsubfield ) = $sth->fetchrow ) {
1642 my $tag = $record->field($tagfield);
1644 $tag->update( $tagsubfield => $value );
1645 $record->delete_field($tag);
1646 $record->insert_fields_ordered($tag);
1648 $record->add_fields( $tagfield, " ", " ", $tagsubfield => $value );
1654 =head2 TransformHtmlToXml
1656 $xml = TransformHtmlToXml( $tags, $subfields, $values, $indicator,
1657 $ind_tag, $auth_type )
1659 $auth_type contains :
1663 =item - nothing : rebuild a biblio. In UNIMARC the encoding is in 100$a pos 26/27
1665 =item - UNIMARCAUTH : rebuild an authority. In UNIMARC, the encoding is in 100$a pos 13/14
1667 =item - ITEM : rebuild an item : in UNIMARC, 100$a, it's in the biblio ! (otherwise, we would get 2 100 fields !)
1673 sub TransformHtmlToXml {
1674 my ( $tags, $subfields, $values, $indicator, $ind_tag, $auth_type ) = @_;
1675 my $xml = MARC::File::XML::header('UTF-8');
1676 $xml .= "<record>\n";
1677 $auth_type = C4::Context->preference('marcflavour') unless $auth_type;
1678 MARC::File::XML->default_record_format($auth_type);
1680 # in UNIMARC, field 100 contains the encoding
1681 # check that there is one, otherwise the
1682 # MARC::Record->new_from_xml will fail (and Koha will die)
1683 my $unimarc_and_100_exist = 0;
1684 $unimarc_and_100_exist = 1 if $auth_type eq 'ITEM'; # if we rebuild an item, no need of a 100 field
1689 for ( my $i = 0 ; $i < @$tags ; $i++ ) {
1691 if ( C4::Context->preference('marcflavour') eq 'UNIMARC' and @$tags[$i] eq "100" and @$subfields[$i] eq "a" ) {
1693 # if we have a 100 field and it's values are not correct, skip them.
1694 # if we don't have any valid 100 field, we will create a default one at the end
1695 my $enc = substr( @$values[$i], 26, 2 );
1696 if ( $enc eq '01' or $enc eq '50' or $enc eq '03' ) {
1697 $unimarc_and_100_exist = 1;
1702 @$values[$i] =~ s/&/&/g;
1703 @$values[$i] =~ s/</</g;
1704 @$values[$i] =~ s/>/>/g;
1705 @$values[$i] =~ s/"/"/g;
1706 @$values[$i] =~ s/'/'/g;
1708 # if ( !utf8::is_utf8( @$values[$i] ) ) {
1709 # utf8::decode( @$values[$i] );
1711 if ( ( @$tags[$i] ne $prevtag ) ) {
1712 $j++ unless ( @$tags[$i] eq "" );
1713 my $indicator1 = eval { substr( @$indicator[$j], 0, 1 ) };
1714 my $indicator2 = eval { substr( @$indicator[$j], 1, 1 ) };
1715 my $ind1 = _default_ind_to_space($indicator1);
1717 if ( @$indicator[$j] ) {
1718 $ind2 = _default_ind_to_space($indicator2);
1720 warn "Indicator in @$tags[$i] is empty";
1724 $xml .= "</datafield>\n";
1725 if ( ( @$tags[$i] && @$tags[$i] > 10 )
1726 && ( @$values[$i] ne "" ) ) {
1727 $xml .= "<datafield tag=\"@$tags[$i]\" ind1=\"$ind1\" ind2=\"$ind2\">\n";
1728 $xml .= "<subfield code=\"@$subfields[$i]\">@$values[$i]</subfield>\n";
1734 if ( @$values[$i] ne "" ) {
1737 if ( @$tags[$i] eq "000" ) {
1738 $xml .= "<leader>@$values[$i]</leader>\n";
1741 # rest of the fixed fields
1742 } elsif ( @$tags[$i] < 10 ) {
1743 $xml .= "<controlfield tag=\"@$tags[$i]\">@$values[$i]</controlfield>\n";
1746 $xml .= "<datafield tag=\"@$tags[$i]\" ind1=\"$ind1\" ind2=\"$ind2\">\n";
1747 $xml .= "<subfield code=\"@$subfields[$i]\">@$values[$i]</subfield>\n";
1752 } else { # @$tags[$i] eq $prevtag
1753 my $indicator1 = eval { substr( @$indicator[$j], 0, 1 ) };
1754 my $indicator2 = eval { substr( @$indicator[$j], 1, 1 ) };
1755 my $ind1 = _default_ind_to_space($indicator1);
1757 if ( @$indicator[$j] ) {
1758 $ind2 = _default_ind_to_space($indicator2);
1760 warn "Indicator in @$tags[$i] is empty";
1763 if ( @$values[$i] eq "" ) {
1766 $xml .= "<datafield tag=\"@$tags[$i]\" ind1=\"$ind1\" ind2=\"$ind2\">\n";
1769 $xml .= "<subfield code=\"@$subfields[$i]\">@$values[$i]</subfield>\n";
1772 $prevtag = @$tags[$i];
1774 $xml .= "</datafield>\n" if @$tags > 0;
1775 if ( C4::Context->preference('marcflavour') eq 'UNIMARC' and !$unimarc_and_100_exist ) {
1777 # warn "SETTING 100 for $auth_type";
1778 my $string = strftime( "%Y%m%d", localtime(time) );
1780 # set 50 to position 26 is biblios, 13 if authorities
1782 $pos = 13 if $auth_type eq 'UNIMARCAUTH';
1783 $string = sprintf( "%-*s", 35, $string );
1784 substr( $string, $pos, 6, "50" );
1785 $xml .= "<datafield tag=\"100\" ind1=\"\" ind2=\"\">\n";
1786 $xml .= "<subfield code=\"a\">$string</subfield>\n";
1787 $xml .= "</datafield>\n";
1789 $xml .= "</record>\n";
1790 $xml .= MARC::File::XML::footer();
1794 =head2 _default_ind_to_space
1796 Passed what should be an indicator returns a space
1797 if its undefined or zero length
1801 sub _default_ind_to_space {
1803 if ( !defined $s || $s eq q{} ) {
1809 =head2 TransformHtmlToMarc
1811 L<$record> = TransformHtmlToMarc(L<$params>,L<$cgi>)
1812 L<$params> is a ref to an array as below:
1814 'tag_010_indicator1_531951' ,
1815 'tag_010_indicator2_531951' ,
1816 'tag_010_code_a_531951_145735' ,
1817 'tag_010_subfield_a_531951_145735' ,
1818 'tag_200_indicator1_873510' ,
1819 'tag_200_indicator2_873510' ,
1820 'tag_200_code_a_873510_673465' ,
1821 'tag_200_subfield_a_873510_673465' ,
1822 'tag_200_code_b_873510_704318' ,
1823 'tag_200_subfield_b_873510_704318' ,
1824 'tag_200_code_e_873510_280822' ,
1825 'tag_200_subfield_e_873510_280822' ,
1826 'tag_200_code_f_873510_110730' ,
1827 'tag_200_subfield_f_873510_110730' ,
1829 L<$cgi> is the CGI object which containts the value.
1830 L<$record> is the MARC::Record object.
1834 sub TransformHtmlToMarc {
1838 # explicitly turn on the UTF-8 flag for all
1839 # 'tag_' parameters to avoid incorrect character
1840 # conversion later on
1841 my $cgi_params = $cgi->Vars;
1842 foreach my $param_name ( keys %$cgi_params ) {
1843 if ( $param_name =~ /^tag_/ ) {
1844 my $param_value = $cgi_params->{$param_name};
1845 if ( utf8::decode($param_value) ) {
1846 $cgi_params->{$param_name} = $param_value;
1849 # FIXME - need to do something if string is not valid UTF-8
1853 # creating a new record
1854 my $record = MARC::Record->new();
1857 while ( $params->[$i] ) { # browse all CGI params
1858 my $param = $params->[$i];
1861 # if we are on biblionumber, store it in the MARC::Record (it may not be in the edited fields)
1862 if ( $param eq 'biblionumber' ) {
1863 my ( $biblionumbertagfield, $biblionumbertagsubfield ) = &GetMarcFromKohaField( "biblio.biblionumber", '' );
1864 if ( $biblionumbertagfield < 10 ) {
1865 $newfield = MARC::Field->new( $biblionumbertagfield, $cgi->param($param), );
1867 $newfield = MARC::Field->new( $biblionumbertagfield, '', '', "$biblionumbertagsubfield" => $cgi->param($param), );
1869 push @fields, $newfield if ($newfield);
1870 } elsif ( $param =~ /^tag_(\d*)_indicator1_/ ) { # new field start when having 'input name="..._indicator1_..."
1873 my $ind1 = _default_ind_to_space( substr( $cgi->param($param), 0, 1 ) );
1874 my $ind2 = _default_ind_to_space( substr( $cgi->param( $params->[ $i + 1 ] ), 0, 1 ) );
1878 if ( $tag < 10 ) { # no code for theses fields
1879 # in MARC editor, 000 contains the leader.
1880 if ( $tag eq '000' ) {
1881 $record->leader( $cgi->param( $params->[ $j + 1 ] ) ) if length( $cgi->param( $params->[ $j + 1 ] ) ) == 24;
1883 # between 001 and 009 (included)
1884 } elsif ( $cgi->param( $params->[ $j + 1 ] ) ne '' ) {
1885 $newfield = MARC::Field->new( $tag, $cgi->param( $params->[ $j + 1 ] ), );
1888 # > 009, deal with subfields
1890 while ( defined $params->[$j] && $params->[$j] =~ /_code_/ ) { # browse all it's subfield
1891 my $inner_param = $params->[$j];
1893 if ( $cgi->param( $params->[ $j + 1 ] ) ne '' ) { # only if there is a value (code => value)
1894 $newfield->add_subfields( $cgi->param($inner_param) => $cgi->param( $params->[ $j + 1 ] ) );
1897 if ( $cgi->param( $params->[ $j + 1 ] ) ne '' ) { # creating only if there is a value (code => value)
1898 $newfield = MARC::Field->new( $tag, $ind1, $ind2, $cgi->param($inner_param) => $cgi->param( $params->[ $j + 1 ] ), );
1904 push @fields, $newfield if ($newfield);
1909 $record->append_fields(@fields);
1913 # cache inverted MARC field map
1914 our $inverted_field_map;
1916 =head2 TransformMarcToKoha
1918 $result = TransformMarcToKoha( $dbh, $record, $frameworkcode )
1920 Extract data from a MARC bib record into a hashref representing
1921 Koha biblio, biblioitems, and items fields.
1925 sub TransformMarcToKoha {
1926 my ( $dbh, $record, $frameworkcode, $limit_table ) = @_;
1929 $limit_table = $limit_table || 0;
1930 $frameworkcode = '' unless defined $frameworkcode;
1932 unless ( defined $inverted_field_map ) {
1933 $inverted_field_map = _get_inverted_marc_field_map();
1937 if ( defined $limit_table && $limit_table eq 'items' ) {
1938 $tables{'items'} = 1;
1940 $tables{'items'} = 1;
1941 $tables{'biblio'} = 1;
1942 $tables{'biblioitems'} = 1;
1945 # traverse through record
1946 MARCFIELD: foreach my $field ( $record->fields() ) {
1947 my $tag = $field->tag();
1948 next MARCFIELD unless exists $inverted_field_map->{$frameworkcode}->{$tag};
1949 if ( $field->is_control_field() ) {
1950 my $kohafields = $inverted_field_map->{$frameworkcode}->{$tag}->{list};
1951 ENTRY: foreach my $entry ( @{$kohafields} ) {
1952 my ( $subfield, $table, $column ) = @{$entry};
1953 next ENTRY unless exists $tables{$table};
1954 my $key = _disambiguate( $table, $column );
1955 if ( $result->{$key} ) {
1956 unless ( ( $key eq "biblionumber" or $key eq "biblioitemnumber" ) and ( $field->data() eq "" ) ) {
1957 $result->{$key} .= " | " . $field->data();
1960 $result->{$key} = $field->data();
1965 # deal with subfields
1966 MARCSUBFIELD: foreach my $sf ( $field->subfields() ) {
1967 my $code = $sf->[0];
1968 next MARCSUBFIELD unless exists $inverted_field_map->{$frameworkcode}->{$tag}->{sfs}->{$code};
1969 my $value = $sf->[1];
1970 SFENTRY: foreach my $entry ( @{ $inverted_field_map->{$frameworkcode}->{$tag}->{sfs}->{$code} } ) {
1971 my ( $table, $column ) = @{$entry};
1972 next SFENTRY unless exists $tables{$table};
1973 my $key = _disambiguate( $table, $column );
1974 if ( $result->{$key} ) {
1975 unless ( ( $key eq "biblionumber" or $key eq "biblioitemnumber" ) and ( $value eq "" ) ) {
1976 $result->{$key} .= " | " . $value;
1979 $result->{$key} = $value;
1986 # modify copyrightdate to keep only the 1st year found
1987 if ( exists $result->{'copyrightdate'} ) {
1988 my $temp = $result->{'copyrightdate'};
1989 $temp =~ m/c(\d\d\d\d)/;
1990 if ( $temp =~ m/c(\d\d\d\d)/ and $1 > 0 ) { # search cYYYY first
1991 $result->{'copyrightdate'} = $1;
1992 } else { # if no cYYYY, get the 1st date.
1993 $temp =~ m/(\d\d\d\d)/;
1994 $result->{'copyrightdate'} = $1;
1998 # modify publicationyear to keep only the 1st year found
1999 if ( exists $result->{'publicationyear'} ) {
2000 my $temp = $result->{'publicationyear'};
2001 if ( $temp =~ m/c(\d\d\d\d)/ and $1 > 0 ) { # search cYYYY first
2002 $result->{'publicationyear'} = $1;
2003 } else { # if no cYYYY, get the 1st date.
2004 $temp =~ m/(\d\d\d\d)/;
2005 $result->{'publicationyear'} = $1;
2012 sub _get_inverted_marc_field_map {
2014 my $relations = C4::Context->marcfromkohafield;
2016 foreach my $frameworkcode ( keys %{$relations} ) {
2017 foreach my $kohafield ( keys %{ $relations->{$frameworkcode} } ) {
2018 next unless @{ $relations->{$frameworkcode}->{$kohafield} }; # not all columns are mapped to MARC tag & subfield
2019 my $tag = $relations->{$frameworkcode}->{$kohafield}->[0];
2020 my $subfield = $relations->{$frameworkcode}->{$kohafield}->[1];
2021 my ( $table, $column ) = split /[.]/, $kohafield, 2;
2022 push @{ $field_map->{$frameworkcode}->{$tag}->{list} }, [ $subfield, $table, $column ];
2023 push @{ $field_map->{$frameworkcode}->{$tag}->{sfs}->{$subfield} }, [ $table, $column ];
2029 =head2 _disambiguate
2031 $newkey = _disambiguate($table, $field);
2033 This is a temporary hack to distinguish between the
2034 following sets of columns when using TransformMarcToKoha.
2036 items.cn_source & biblioitems.cn_source
2037 items.cn_sort & biblioitems.cn_sort
2039 Columns that are currently NOT distinguished (FIXME
2040 due to lack of time to fully test) are:
2042 biblio.notes and biblioitems.notes
2047 FIXME - this is necessary because prefixing each column
2048 name with the table name would require changing lots
2049 of code and templates, and exposing more of the DB
2050 structure than is good to the UI templates, particularly
2051 since biblio and bibloitems may well merge in a future
2052 version. In the future, it would also be good to
2053 separate DB access and UI presentation field names
2058 sub CountItemsIssued {
2059 my ($biblionumber) = @_;
2060 my $dbh = C4::Context->dbh;
2061 my $sth = $dbh->prepare('SELECT COUNT(*) as issuedCount FROM items, issues WHERE items.itemnumber = issues.itemnumber AND items.biblionumber = ?');
2062 $sth->execute($biblionumber);
2063 my $row = $sth->fetchrow_hashref();
2064 return $row->{'issuedCount'};
2068 my ( $table, $column ) = @_;
2069 if ( $column eq "cn_sort" or $column eq "cn_source" ) {
2070 return $table . '.' . $column;
2077 =head2 get_koha_field_from_marc
2079 $result->{_disambiguate($table, $field)} =
2080 get_koha_field_from_marc($table,$field,$record,$frameworkcode);
2082 Internal function to map data from the MARC record to a specific non-MARC field.
2083 FIXME: this is meant to replace TransformMarcToKohaOneField after more testing.
2087 sub get_koha_field_from_marc {
2088 my ( $koha_table, $koha_column, $record, $frameworkcode ) = @_;
2089 my ( $tagfield, $subfield ) = GetMarcFromKohaField( $koha_table . '.' . $koha_column, $frameworkcode );
2091 foreach my $field ( $record->field($tagfield) ) {
2092 if ( $field->tag() < 10 ) {
2094 $kohafield .= " | " . $field->data();
2096 $kohafield = $field->data();
2099 if ( $field->subfields ) {
2100 my @subfields = $field->subfields();
2101 foreach my $subfieldcount ( 0 .. $#subfields ) {
2102 if ( $subfields[$subfieldcount][0] eq $subfield ) {
2104 $kohafield .= " | " . $subfields[$subfieldcount][1];
2106 $kohafield = $subfields[$subfieldcount][1];
2116 =head2 TransformMarcToKohaOneField
2118 $result = TransformMarcToKohaOneField( $kohatable, $kohafield, $record, $result, $frameworkcode )
2122 sub TransformMarcToKohaOneField {
2124 # FIXME ? if a field has a repeatable subfield that is used in old-db,
2125 # only the 1st will be retrieved...
2126 my ( $kohatable, $kohafield, $record, $result, $frameworkcode ) = @_;
2128 my ( $tagfield, $subfield ) = GetMarcFromKohaField( $kohatable . "." . $kohafield, $frameworkcode );
2129 foreach my $field ( $record->field($tagfield) ) {
2130 if ( $field->tag() < 10 ) {
2131 if ( $result->{$kohafield} ) {
2132 $result->{$kohafield} .= " | " . $field->data();
2134 $result->{$kohafield} = $field->data();
2137 if ( $field->subfields ) {
2138 my @subfields = $field->subfields();
2139 foreach my $subfieldcount ( 0 .. $#subfields ) {
2140 if ( $subfields[$subfieldcount][0] eq $subfield ) {
2141 if ( $result->{$kohafield} ) {
2142 $result->{$kohafield} .= " | " . $subfields[$subfieldcount][1];
2144 $result->{$kohafield} = $subfields[$subfieldcount][1];
2154 =head1 OTHER FUNCTIONS
2157 =head2 PrepareItemrecordDisplay
2159 PrepareItemrecordDisplay($itemrecord,$bibnum,$itemumber,$frameworkcode);
2161 Returns a hash with all the fields for Display a given item data in a template
2163 The $frameworkcode returns the item for the given frameworkcode, ONLY if bibnum is not provided
2167 sub PrepareItemrecordDisplay {
2169 my ( $bibnum, $itemnum, $defaultvalues, $frameworkcode ) = @_;
2171 my $dbh = C4::Context->dbh;
2172 $frameworkcode = &GetFrameworkCode($bibnum) if $bibnum;
2173 my ( $itemtagfield, $itemtagsubfield ) = &GetMarcFromKohaField( "items.itemnumber", $frameworkcode );
2174 my $tagslib = &GetMarcStructure( 1, $frameworkcode );
2176 # return nothing if we don't have found an existing framework.
2177 return "" unless $tagslib;
2178 my $itemrecord = C4::Items::GetMarcItem( $bibnum, $itemnum ) if ($itemnum);
2180 my $authorised_values_sth = $dbh->prepare( "SELECT authorised_value,lib FROM authorised_values WHERE category=? ORDER BY lib" );
2181 foreach my $tag ( sort keys %{$tagslib} ) {
2182 my $previous_tag = '';
2185 # loop through each subfield
2187 foreach my $subfield ( sort keys %{ $tagslib->{$tag} } ) {
2188 next if ( subfield_is_koha_internal_p($subfield) );
2189 next if ( $tagslib->{$tag}->{$subfield}->{'tab'} ne "10" );
2191 $subfield_data{tag} = $tag;
2192 $subfield_data{subfield} = $subfield;
2193 $subfield_data{countsubfield} = $cntsubf++;
2194 $subfield_data{kohafield} = $tagslib->{$tag}->{$subfield}->{'kohafield'};
2196 # $subfield_data{marc_lib}=$tagslib->{$tag}->{$subfield}->{lib};
2197 $subfield_data{marc_lib} = $tagslib->{$tag}->{$subfield}->{lib};
2198 $subfield_data{mandatory} = $tagslib->{$tag}->{$subfield}->{mandatory};
2199 $subfield_data{repeatable} = $tagslib->{$tag}->{$subfield}->{repeatable};
2200 $subfield_data{hidden} = "display:none"
2201 if $tagslib->{$tag}->{$subfield}->{hidden};
2202 my ( $x, $defaultvalue );
2204 ( $x, $defaultvalue ) = _find_value( $tag, $subfield, $itemrecord );
2206 $defaultvalue = $tagslib->{$tag}->{$subfield}->{defaultvalue} unless $defaultvalue;
2207 if ( !defined $defaultvalue ) {
2208 $defaultvalue = q||;
2210 $defaultvalue =~ s/"/"/g;
2212 # search for itemcallnumber if applicable
2213 if ( $tagslib->{$tag}->{$subfield}->{kohafield} eq 'items.itemcallnumber'
2214 && C4::Context->preference('itemcallnumber') ) {
2215 my $CNtag = substr( C4::Context->preference('itemcallnumber'), 0, 3 );
2216 my $CNsubfield = substr( C4::Context->preference('itemcallnumber'), 3, 1 );
2217 my $temp = $itemrecord->field($CNtag) if ($itemrecord);
2219 $defaultvalue = $temp->subfield($CNsubfield);
2222 if ( $tagslib->{$tag}->{$subfield}->{kohafield} eq 'items.itemcallnumber'
2224 && $defaultvalues->{'callnumber'} ) {
2225 my $temp = $itemrecord->field($subfield) if ($itemrecord);
2227 $defaultvalue = $defaultvalues->{'callnumber'} if $defaultvalues;
2230 if ( ( $tagslib->{$tag}->{$subfield}->{kohafield} eq 'items.holdingbranch' || $tagslib->{$tag}->{$subfield}->{kohafield} eq 'items.homebranch' )
2232 && $defaultvalues->{'branchcode'} ) {
2233 my $temp = $itemrecord->field($subfield) if ($itemrecord);
2235 $defaultvalue = $defaultvalues->{branchcode} if $defaultvalues;
2238 if ( $tagslib->{$tag}->{$subfield}->{authorised_value} ) {
2239 my @authorised_values;
2242 # builds list, depending on authorised value...
2244 if ( $tagslib->{$tag}->{$subfield}->{'authorised_value'} eq "branches" ) {
2245 if ( ( C4::Context->preference("IndependantBranches") )
2246 && ( C4::Context->userenv->{flags} % 2 != 1 ) ) {
2247 my $sth = $dbh->prepare( "SELECT branchcode,branchname FROM branches WHERE branchcode = ? ORDER BY branchname" );
2248 $sth->execute( C4::Context->userenv->{branch} );
2249 push @authorised_values, ""
2250 unless ( $tagslib->{$tag}->{$subfield}->{mandatory} );
2251 while ( my ( $branchcode, $branchname ) = $sth->fetchrow_array ) {
2252 push @authorised_values, $branchcode;
2253 $authorised_lib{$branchcode} = $branchname;
2256 my $sth = $dbh->prepare( "SELECT branchcode,branchname FROM branches ORDER BY branchname" );
2258 push @authorised_values, ""
2259 unless ( $tagslib->{$tag}->{$subfield}->{mandatory} );
2260 while ( my ( $branchcode, $branchname ) = $sth->fetchrow_array ) {
2261 push @authorised_values, $branchcode;
2262 $authorised_lib{$branchcode} = $branchname;
2267 } elsif ( $tagslib->{$tag}->{$subfield}->{authorised_value} eq "itemtypes" ) {
2268 my $sth = $dbh->prepare( "SELECT itemtype,description FROM itemtypes ORDER BY description" );
2270 push @authorised_values, ""
2271 unless ( $tagslib->{$tag}->{$subfield}->{mandatory} );
2272 while ( my ( $itemtype, $description ) = $sth->fetchrow_array ) {
2273 push @authorised_values, $itemtype;
2274 $authorised_lib{$itemtype} = $description;
2277 } elsif ( $tagslib->{$tag}->{$subfield}->{authorised_value} eq "cn_source" ) {
2278 push @authorised_values, "" unless ( $tagslib->{$tag}->{$subfield}->{mandatory} );
2280 my $class_sources = GetClassSources();
2281 my $default_source = C4::Context->preference("DefaultClassificationSource");
2283 foreach my $class_source (sort keys %$class_sources) {
2284 next unless $class_sources->{$class_source}->{'used'} or
2285 ($class_source eq $default_source);
2286 push @authorised_values, $class_source;
2287 $authorised_lib{$class_source} = $class_sources->{$class_source}->{'description'};
2290 #---- "true" authorised value
2292 $authorised_values_sth->execute( $tagslib->{$tag}->{$subfield}->{authorised_value} );
2293 push @authorised_values, ""
2294 unless ( $tagslib->{$tag}->{$subfield}->{mandatory} );
2295 while ( my ( $value, $lib ) = $authorised_values_sth->fetchrow_array ) {
2296 push @authorised_values, $value;
2297 $authorised_lib{$value} = $lib;
2300 $subfield_data{marc_value} = CGI::scrolling_list(
2301 -name => 'field_value',
2302 -values => \@authorised_values,
2303 -default => "$defaultvalue",
2304 -labels => \%authorised_lib,
2310 $subfield_data{marc_value} = "<input type=\"text\" name=\"field_value\" value=\"$defaultvalue\" size=\"50\" maxlength=\"255\" />";
2312 push( @loop_data, \%subfield_data );
2316 my $itemnumber = $itemrecord->subfield( $itemtagfield, $itemtagsubfield )
2317 if ( $itemrecord && $itemrecord->field($itemtagfield) );
2319 'itemtagfield' => $itemtagfield,
2320 'itemtagsubfield' => $itemtagsubfield,
2321 'itemnumber' => $itemnumber,
2322 'iteminformation' => \@loop_data
2329 # true ModZebra commented until indexdata fixes zebraDB crashes (it seems they occur on multiple updates
2331 # replaced by a zebraqueue table, that is filled with ModZebra to run.
2332 # the table is emptied by misc/cronjobs/zebraqueue_start.pl script
2333 # =head2 ModZebrafiles
2335 # &ModZebrafiles( $dbh, $biblionumber, $record, $folder, $server );
2339 # sub ModZebrafiles {
2341 # my ( $dbh, $biblionumber, $record, $folder, $server ) = @_;
2345 # C4::Context->zebraconfig($server)->{directory} . "/" . $folder . "/";
2346 # unless ( opendir( DIR, "$zebradir" ) ) {
2347 # warn "$zebradir not found";
2351 # my $filename = $zebradir . $biblionumber;
2354 # open( OUTPUT, ">", $filename . ".xml" );
2355 # print OUTPUT $record;
2362 ModZebra( $biblionumber, $op, $server, $oldRecord, $newRecord );
2364 $biblionumber is the biblionumber we want to index
2366 $op is specialUpdate or delete, and is used to know what we want to do
2368 $server is the server that we want to update
2370 $oldRecord is the MARC::Record containing the previous version of the record. This is used only when
2371 NoZebra=1, as NoZebra indexing needs to know the previous version of a record in order to
2374 $newRecord is the MARC::Record containing the new record. It is usefull only when NoZebra=1, and is used to know what to add to the nozebra database. (the record in mySQL being, if it exist, the previous record, the one just before the modif. We need both : the previous and the new one.
2379 ###Accepts a $server variable thus we can use it for biblios authorities or other zebra dbs
2380 my ( $biblionumber, $op, $server, $oldRecord, $newRecord ) = @_;
2381 my $dbh = C4::Context->dbh;
2383 # true ModZebra commented until indexdata fixes zebraDB crashes (it seems they occur on multiple updates
2385 # replaced by a zebraqueue table, that is filled with ModZebra to run.
2386 # the table is emptied by misc/cronjobs/zebraqueue_start.pl script
2388 if ( C4::Context->preference("NoZebra") ) {
2390 # lock the nozebra table : we will read index lines, update them in Perl process
2391 # and write everything in 1 transaction.
2392 # lock the table to avoid someone else overwriting what we are doing
2393 $dbh->do('LOCK TABLES nozebra WRITE,biblio WRITE,biblioitems WRITE, systempreferences WRITE, auth_types WRITE, auth_header WRITE, auth_subfield_structure READ');
2394 my %result; # the result hash that will be built by deletion / add, and written on mySQL at the end, to improve speed
2395 if ( $op eq 'specialUpdate' ) {
2397 # OK, we have to add or update the record
2398 # 1st delete (virtually, in indexes), if record actually exists
2400 %result = _DelBiblioNoZebra( $biblionumber, $oldRecord, $server );
2403 # ... add the record
2404 %result = _AddBiblioNoZebra( $biblionumber, $newRecord, $server, %result );
2407 # it's a deletion, delete the record...
2408 # warn "DELETE the record $biblionumber on $server".$record->as_formatted;
2409 %result = _DelBiblioNoZebra( $biblionumber, $oldRecord, $server );
2412 # ok, now update the database...
2413 my $sth = $dbh->prepare("UPDATE nozebra SET biblionumbers=? WHERE server=? AND indexname=? AND value=?");
2414 foreach my $key ( keys %result ) {
2415 foreach my $index ( keys %{ $result{$key} } ) {
2416 $sth->execute( $result{$key}->{$index}, $server, $key, $index );
2419 $dbh->do('UNLOCK TABLES');
2423 # we use zebra, just fill zebraqueue table
2425 my $check_sql = "SELECT COUNT(*) FROM zebraqueue
2427 AND biblio_auth_number = ?
2430 my $check_sth = $dbh->prepare_cached($check_sql);
2431 $check_sth->execute( $server, $biblionumber, $op );
2432 my ($count) = $check_sth->fetchrow_array;
2433 $check_sth->finish();
2434 if ( $count == 0 ) {
2435 my $sth = $dbh->prepare("INSERT INTO zebraqueue (biblio_auth_number,server,operation) VALUES(?,?,?)");
2436 $sth->execute( $biblionumber, $server, $op );
2442 =head2 GetNoZebraIndexes
2444 %indexes = GetNoZebraIndexes;
2446 return the data from NoZebraIndexes syspref.
2450 sub GetNoZebraIndexes {
2451 my $no_zebra_indexes = C4::Context->preference('NoZebraIndexes');
2453 INDEX: foreach my $line ( split /['"],[\n\r]*/, $no_zebra_indexes ) {
2454 $line =~ /(.*)=>(.*)/;
2455 my $index = $1; # initial ' or " is removed afterwards
2457 $index =~ s/'|"|\s//g;
2458 $fields =~ s/'|"|\s//g;
2459 $indexes{$index} = $fields;
2464 =head1 INTERNAL FUNCTIONS
2466 =head2 _DelBiblioNoZebra($biblionumber,$record,$server);
2468 function to delete a biblio in NoZebra indexes
2469 This function does NOT delete anything in database : it reads all the indexes entries
2470 that have to be deleted & delete them in the hash
2472 The SQL part is done either :
2473 - after the Add if we are modifying a biblio (delete + add again)
2474 - immediatly after this sub if we are doing a true deletion.
2476 $server can be 'biblioserver' or 'authorityserver' : it indexes biblios or authorities (in the same table, $server being part of the table itself
2480 sub _DelBiblioNoZebra {
2481 my ( $biblionumber, $record, $server ) = @_;
2484 my $dbh = C4::Context->dbh;
2489 if ( $server eq 'biblioserver' ) {
2490 %index = GetNoZebraIndexes;
2492 # get title of the record (to store the 10 first letters with the index)
2493 my ( $titletag, $titlesubfield ) = GetMarcFromKohaField( 'biblio.title', '' ); # FIXME: should be GetFrameworkCode($biblionumber) ??
2494 $title = lc( $record->subfield( $titletag, $titlesubfield ) );
2497 # for authorities, the "title" is the $a mainentry
2498 my ( $auth_type_tag, $auth_type_sf ) = C4::AuthoritiesMarc::get_auth_type_location();
2499 my $authref = C4::AuthoritiesMarc::GetAuthType( $record->subfield( $auth_type_tag, $auth_type_sf ) );
2500 warn "ERROR : authtype undefined for " . $record->as_formatted unless $authref;
2501 $title = $record->subfield( $authref->{auth_tag_to_report}, 'a' );
2502 $index{'mainmainentry'} = $authref->{'auth_tag_to_report'} . 'a';
2503 $index{'mainentry'} = $authref->{'auth_tag_to_report'} . '*';
2504 $index{'auth_type'} = "${auth_type_tag}${auth_type_sf}";
2509 # remove blancks comma (that could cause problem when decoding the string for CQL retrieval) and regexp specific values
2510 $title =~ s/ |,|;|\[|\]|\(|\)|\*|-|'|=//g;
2512 # limit to 10 char, should be enough, and limit the DB size
2513 $title = substr( $title, 0, 10 );
2516 my $sth2 = $dbh->prepare('SELECT biblionumbers FROM nozebra WHERE server=? AND indexname=? AND value=?');
2517 foreach my $field ( $record->fields() ) {
2519 #parse each subfield
2520 next if $field->tag < 10;
2521 foreach my $subfield ( $field->subfields() ) {
2522 my $tag = $field->tag();
2523 my $subfieldcode = $subfield->[0];
2526 # check each index to see if the subfield is stored somewhere
2527 # otherwise, store it in __RAW__ index
2528 foreach my $key ( keys %index ) {
2530 # warn "examining $key index : ".$index{$key}." for $tag $subfieldcode";
2531 if ( $index{$key} =~ /$tag\*/ or $index{$key} =~ /$tag$subfieldcode/ ) {
2533 my $line = lc $subfield->[1];
2535 # remove meaningless value in the field...
2536 $line =~ s/-|\.|\?|,|;|!|'|\(|\)|\[|\]|{|}|"|<|>|&|\+|\*|\/|=|:/ /g;
2538 # ... and split in words
2539 foreach ( split / /, $line ) {
2540 next unless $_; # skip empty values (multiple spaces)
2541 # if the entry is already here, do nothing, the biblionumber has already be removed
2542 unless ( defined( $result{$key}->{$_} ) && ( $result{$key}->{$_} =~ /$biblionumber,$title\-(\d);/ ) ) {
2544 # get the index value if it exist in the nozebra table and remove the entry, otherwise, do nothing
2545 $sth2->execute( $server, $key, $_ );
2546 my $existing_biblionumbers = $sth2->fetchrow;
2549 if ($existing_biblionumbers) {
2551 # warn " existing for $key $_: $existing_biblionumbers";
2552 $result{$key}->{$_} = $existing_biblionumbers;
2553 $result{$key}->{$_} =~ s/$biblionumber,$title\-(\d);//;
2560 # the subfield is not indexed, store it in __RAW__ index anyway
2562 my $line = lc $subfield->[1];
2563 $line =~ s/-|\.|\?|,|;|!|'|\(|\)|\[|\]|{|}|"|<|>|&|\+|\*|\/|=|:/ /g;
2565 # ... and split in words
2566 foreach ( split / /, $line ) {
2567 next unless $_; # skip empty values (multiple spaces)
2568 # if the entry is already here, do nothing, the biblionumber has already be removed
2569 unless ( $result{'__RAW__'}->{$_} =~ /$biblionumber,$title\-(\d);/ ) {
2571 # get the index value if it exist in the nozebra table and remove the entry, otherwise, do nothing
2572 $sth2->execute( $server, '__RAW__', $_ );
2573 my $existing_biblionumbers = $sth2->fetchrow;
2576 if ($existing_biblionumbers) {
2577 $result{'__RAW__'}->{$_} = $existing_biblionumbers;
2578 $result{'__RAW__'}->{$_} =~ s/$biblionumber,$title\-(\d);//;
2588 =head2 _AddBiblioNoZebra
2590 _AddBiblioNoZebra($biblionumber, $record, $server, %result);
2592 function to add a biblio in NoZebra indexes
2596 sub _AddBiblioNoZebra {
2597 my ( $biblionumber, $record, $server, %result ) = @_;
2598 my $dbh = C4::Context->dbh;
2603 if ( $server eq 'biblioserver' ) {
2604 %index = GetNoZebraIndexes;
2606 # get title of the record (to store the 10 first letters with the index)
2607 my ( $titletag, $titlesubfield ) = GetMarcFromKohaField( 'biblio.title', '' ); # FIXME: should be GetFrameworkCode($biblionumber) ??
2608 $title = lc( $record->subfield( $titletag, $titlesubfield ) );
2611 # warn "server : $server";
2612 # for authorities, the "title" is the $a mainentry
2613 my ( $auth_type_tag, $auth_type_sf ) = C4::AuthoritiesMarc::get_auth_type_location();
2614 my $authref = C4::AuthoritiesMarc::GetAuthType( $record->subfield( $auth_type_tag, $auth_type_sf ) );
2615 warn "ERROR : authtype undefined for " . $record->as_formatted unless $authref;
2616 $title = $record->subfield( $authref->{auth_tag_to_report}, 'a' );
2617 $index{'mainmainentry'} = $authref->{auth_tag_to_report} . 'a';
2618 $index{'mainentry'} = $authref->{auth_tag_to_report} . '*';
2619 $index{'auth_type'} = "${auth_type_tag}${auth_type_sf}";
2622 # remove blancks comma (that could cause problem when decoding the string for CQL retrieval) and regexp specific values
2623 $title =~ s/ |\.|,|;|\[|\]|\(|\)|\*|-|'|:|=|\r|\n//g;
2625 # limit to 10 char, should be enough, and limit the DB size
2626 $title = substr( $title, 0, 10 );
2629 my $sth2 = $dbh->prepare('SELECT biblionumbers FROM nozebra WHERE server=? AND indexname=? AND value=?');
2630 foreach my $field ( $record->fields() ) {
2632 #parse each subfield
2633 ###FIXME: impossible to index a 001-009 value with NoZebra
2634 next if $field->tag < 10;
2635 foreach my $subfield ( $field->subfields() ) {
2636 my $tag = $field->tag();
2637 my $subfieldcode = $subfield->[0];
2640 # warn "INDEXING :".$subfield->[1];
2641 # check each index to see if the subfield is stored somewhere
2642 # otherwise, store it in __RAW__ index
2643 foreach my $key ( keys %index ) {
2645 # warn "examining $key index : ".$index{$key}." for $tag $subfieldcode";
2646 if ( $index{$key} =~ /$tag\*/ or $index{$key} =~ /$tag$subfieldcode/ ) {
2648 my $line = lc $subfield->[1];
2650 # remove meaningless value in the field...
2651 $line =~ s/-|\.|\?|,|;|!|'|\(|\)|\[|\]|{|}|"|<|>|&|\+|\*|\/|=|:|\r|\n/ /g;
2653 # ... and split in words
2654 foreach ( split / /, $line ) {
2655 next unless $_; # skip empty values (multiple spaces)
2656 # if the entry is already here, improve weight
2658 # warn "managing $_";
2659 if ( exists $result{$key}->{$_} && $result{$key}->{"$_"} =~ /$biblionumber,\Q$title\E\-(\d+);/ ) {
2660 my $weight = $1 + 1;
2661 $result{$key}->{"$_"} =~ s/$biblionumber,\Q$title\E\-(\d+);//g;
2662 $result{$key}->{"$_"} .= "$biblionumber,$title-$weight;";
2665 # get the value if it exist in the nozebra table, otherwise, create it
2666 $sth2->execute( $server, $key, $_ );
2667 my $existing_biblionumbers = $sth2->fetchrow;
2670 if ($existing_biblionumbers) {
2671 $result{$key}->{"$_"} = $existing_biblionumbers;
2672 my $weight = defined $1 ? $1 + 1 : 1;
2673 $result{$key}->{"$_"} =~ s/$biblionumber,\Q$title\E\-(\d+);//g;
2674 $result{$key}->{"$_"} .= "$biblionumber,$title-$weight;";
2676 # create a new ligne for this entry
2679 # warn "INSERT : $server / $key / $_";
2680 $dbh->do( 'INSERT INTO nozebra SET server=' . $dbh->quote($server) . ', indexname=' . $dbh->quote($key) . ',value=' . $dbh->quote($_) );
2681 $result{$key}->{"$_"} .= "$biblionumber,$title-1;";
2688 # the subfield is not indexed, store it in __RAW__ index anyway
2690 my $line = lc $subfield->[1];
2691 $line =~ s/-|\.|\?|,|;|!|'|\(|\)|\[|\]|{|}|"|<|>|&|\+|\*|\/|=|:|\r|\n/ /g;
2693 # ... and split in words
2694 foreach ( split / /, $line ) {
2695 next unless $_; # skip empty values (multiple spaces)
2696 # if the entry is already here, improve weight
2697 my $tmpstr = $result{'__RAW__'}->{"$_"} || "";
2698 if ( $tmpstr =~ /$biblionumber,\Q$title\E\-(\d+);/ ) {
2699 my $weight = $1 + 1;
2700 $result{'__RAW__'}->{"$_"} =~ s/$biblionumber,\Q$title\E\-(\d+);//;
2701 $result{'__RAW__'}->{"$_"} .= "$biblionumber,$title-$weight;";
2704 # get the value if it exist in the nozebra table, otherwise, create it
2705 $sth2->execute( $server, '__RAW__', $_ );
2706 my $existing_biblionumbers = $sth2->fetchrow;
2709 if ($existing_biblionumbers) {
2710 $result{'__RAW__'}->{"$_"} = $existing_biblionumbers;
2711 my $weight = ( $1 ? $1 : 0 ) + 1;
2712 $result{'__RAW__'}->{"$_"} =~ s/$biblionumber,\Q$title\E\-(\d+);//;
2713 $result{'__RAW__'}->{"$_"} .= "$biblionumber,$title-$weight;";
2715 # create a new ligne for this entry
2717 $dbh->do( 'INSERT INTO nozebra SET server=' . $dbh->quote($server) . ', indexname="__RAW__",value=' . $dbh->quote($_) );
2718 $result{'__RAW__'}->{"$_"} .= "$biblionumber,$title-1;";
2730 ($indicators, $value) = _find_value($tag, $subfield, $record,$encoding);
2732 Find the given $subfield in the given $tag in the given
2733 MARC::Record $record. If the subfield is found, returns
2734 the (indicators, value) pair; otherwise, (undef, undef) is
2738 Such a function is used in addbiblio AND additem and serial-edit and maybe could be used in Authorities.
2739 I suggest we export it from this module.
2744 my ( $tagfield, $insubfield, $record, $encoding ) = @_;
2747 if ( $tagfield < 10 ) {
2748 if ( $record->field($tagfield) ) {
2749 push @result, $record->field($tagfield)->data();
2754 foreach my $field ( $record->field($tagfield) ) {
2755 my @subfields = $field->subfields();
2756 foreach my $subfield (@subfields) {
2757 if ( @$subfield[0] eq $insubfield ) {
2758 push @result, @$subfield[1];
2759 $indicator = $field->indicator(1) . $field->indicator(2);
2764 return ( $indicator, @result );
2767 =head2 _koha_marc_update_bib_ids
2770 _koha_marc_update_bib_ids($record, $frameworkcode, $biblionumber, $biblioitemnumber);
2772 Internal function to add or update biblionumber and biblioitemnumber to
2777 sub _koha_marc_update_bib_ids {
2778 my ( $record, $frameworkcode, $biblionumber, $biblioitemnumber ) = @_;
2780 # we must add bibnum and bibitemnum in MARC::Record...
2781 # we build the new field with biblionumber and biblioitemnumber
2782 # we drop the original field
2783 # we add the new builded field.
2784 my ( $biblio_tag, $biblio_subfield ) = GetMarcFromKohaField( "biblio.biblionumber", $frameworkcode );
2785 my ( $biblioitem_tag, $biblioitem_subfield ) = GetMarcFromKohaField( "biblioitems.biblioitemnumber", $frameworkcode );
2787 if ( $biblio_tag != $biblioitem_tag ) {
2789 # biblionumber & biblioitemnumber are in different fields
2791 # deal with biblionumber
2792 my ( $new_field, $old_field );
2793 if ( $biblio_tag < 10 ) {
2794 $new_field = MARC::Field->new( $biblio_tag, $biblionumber );
2796 $new_field = MARC::Field->new( $biblio_tag, '', '', "$biblio_subfield" => $biblionumber );
2799 # drop old field and create new one...
2800 $old_field = $record->field($biblio_tag);
2801 $record->delete_field($old_field) if $old_field;
2802 $record->append_fields($new_field);
2804 # deal with biblioitemnumber
2805 if ( $biblioitem_tag < 10 ) {
2806 $new_field = MARC::Field->new( $biblioitem_tag, $biblioitemnumber, );
2808 $new_field = MARC::Field->new( $biblioitem_tag, '', '', "$biblioitem_subfield" => $biblioitemnumber, );
2811 # drop old field and create new one...
2812 $old_field = $record->field($biblioitem_tag);
2813 $record->delete_field($old_field) if $old_field;
2814 $record->insert_fields_ordered($new_field);
2818 # biblionumber & biblioitemnumber are in the same field (can't be <10 as fields <10 have only 1 value)
2819 my $new_field = MARC::Field->new(
2820 $biblio_tag, '', '',
2821 "$biblio_subfield" => $biblionumber,
2822 "$biblioitem_subfield" => $biblioitemnumber
2825 # drop old field and create new one...
2826 my $old_field = $record->field($biblio_tag);
2827 $record->delete_field($old_field) if $old_field;
2828 $record->insert_fields_ordered($new_field);
2832 =head2 _koha_marc_update_biblioitem_cn_sort
2834 _koha_marc_update_biblioitem_cn_sort($marc, $biblioitem, $frameworkcode);
2836 Given a MARC bib record and the biblioitem hash, update the
2837 subfield that contains a copy of the value of biblioitems.cn_sort.
2841 sub _koha_marc_update_biblioitem_cn_sort {
2843 my $biblioitem = shift;
2844 my $frameworkcode = shift;
2846 my ( $biblioitem_tag, $biblioitem_subfield ) = GetMarcFromKohaField( "biblioitems.cn_sort", $frameworkcode );
2847 return unless $biblioitem_tag;
2849 my ($cn_sort) = GetClassSort( $biblioitem->{'biblioitems.cn_source'}, $biblioitem->{'cn_class'}, $biblioitem->{'cn_item'} );
2851 if ( my $field = $marc->field($biblioitem_tag) ) {
2852 $field->delete_subfield( code => $biblioitem_subfield );
2853 if ( $cn_sort ne '' ) {
2854 $field->add_subfields( $biblioitem_subfield => $cn_sort );
2858 # if we get here, no biblioitem tag is present in the MARC record, so
2859 # we'll create it if $cn_sort is not empty -- this would be
2860 # an odd combination of events, however
2862 $marc->insert_grouped_field( MARC::Field->new( $biblioitem_tag, ' ', ' ', $biblioitem_subfield => $cn_sort ) );
2867 =head2 _koha_add_biblio
2869 my ($biblionumber,$error) = _koha_add_biblio($dbh,$biblioitem);
2871 Internal function to add a biblio ($biblio is a hash with the values)
2875 sub _koha_add_biblio {
2876 my ( $dbh, $biblio, $frameworkcode ) = @_;
2880 # set the series flag
2881 unless (defined $biblio->{'serial'}){
2882 $biblio->{'serial'} = 0;
2883 if ( $biblio->{'seriestitle'} ) { $biblio->{'serial'} = 1 }
2886 my $query = "INSERT INTO biblio
2887 SET frameworkcode = ?,
2898 my $sth = $dbh->prepare($query);
2900 $frameworkcode, $biblio->{'author'}, $biblio->{'title'}, $biblio->{'unititle'}, $biblio->{'notes'},
2901 $biblio->{'serial'}, $biblio->{'seriestitle'}, $biblio->{'copyrightdate'}, $biblio->{'abstract'}
2904 my $biblionumber = $dbh->{'mysql_insertid'};
2905 if ( $dbh->errstr ) {
2906 $error .= "ERROR in _koha_add_biblio $query" . $dbh->errstr;
2912 #warn "LEAVING _koha_add_biblio: ".$biblionumber."\n";
2913 return ( $biblionumber, $error );
2916 =head2 _koha_modify_biblio
2918 my ($biblionumber,$error) == _koha_modify_biblio($dbh,$biblio,$frameworkcode);
2920 Internal function for updating the biblio table
2924 sub _koha_modify_biblio {
2925 my ( $dbh, $biblio, $frameworkcode ) = @_;
2930 SET frameworkcode = ?,
2939 WHERE biblionumber = ?
2942 my $sth = $dbh->prepare($query);
2945 $frameworkcode, $biblio->{'author'}, $biblio->{'title'}, $biblio->{'unititle'}, $biblio->{'notes'},
2946 $biblio->{'serial'}, $biblio->{'seriestitle'}, $biblio->{'copyrightdate'}, $biblio->{'abstract'}, $biblio->{'biblionumber'}
2947 ) if $biblio->{'biblionumber'};
2949 if ( $dbh->errstr || !$biblio->{'biblionumber'} ) {
2950 $error .= "ERROR in _koha_modify_biblio $query" . $dbh->errstr;
2953 return ( $biblio->{'biblionumber'}, $error );
2956 =head2 _koha_modify_biblioitem_nonmarc
2958 my ($biblioitemnumber,$error) = _koha_modify_biblioitem_nonmarc( $dbh, $biblioitem );
2960 Updates biblioitems row except for marc and marcxml, which should be changed
2965 sub _koha_modify_biblioitem_nonmarc {
2966 my ( $dbh, $biblioitem ) = @_;
2969 # re-calculate the cn_sort, it may have changed
2970 my ($cn_sort) = GetClassSort( $biblioitem->{'biblioitems.cn_source'}, $biblioitem->{'cn_class'}, $biblioitem->{'cn_item'} );
2972 my $query = "UPDATE biblioitems
2973 SET biblionumber = ?,
2979 publicationyear = ?,
2983 collectiontitle = ?,
2985 collectionvolume= ?,
2986 editionstatement= ?,
2987 editionresponsibility = ?,
3001 where biblioitemnumber = ?
3003 my $sth = $dbh->prepare($query);
3005 $biblioitem->{'biblionumber'}, $biblioitem->{'volume'}, $biblioitem->{'number'}, $biblioitem->{'itemtype'},
3006 $biblioitem->{'isbn'}, $biblioitem->{'issn'}, $biblioitem->{'publicationyear'}, $biblioitem->{'publishercode'},
3007 $biblioitem->{'volumedate'}, $biblioitem->{'volumedesc'}, $biblioitem->{'collectiontitle'}, $biblioitem->{'collectionissn'},
3008 $biblioitem->{'collectionvolume'}, $biblioitem->{'editionstatement'}, $biblioitem->{'editionresponsibility'}, $biblioitem->{'illus'},
3009 $biblioitem->{'pages'}, $biblioitem->{'bnotes'}, $biblioitem->{'size'}, $biblioitem->{'place'},
3010 $biblioitem->{'lccn'}, $biblioitem->{'url'}, $biblioitem->{'biblioitems.cn_source'}, $biblioitem->{'cn_class'},
3011 $biblioitem->{'cn_item'}, $biblioitem->{'cn_suffix'}, $cn_sort, $biblioitem->{'totalissues'},
3012 $biblioitem->{'biblioitemnumber'}
3014 if ( $dbh->errstr ) {
3015 $error .= "ERROR in _koha_modify_biblioitem_nonmarc $query" . $dbh->errstr;
3018 return ( $biblioitem->{'biblioitemnumber'}, $error );
3021 =head2 _koha_add_biblioitem
3023 my ($biblioitemnumber,$error) = _koha_add_biblioitem( $dbh, $biblioitem );
3025 Internal function to add a biblioitem
3029 sub _koha_add_biblioitem {
3030 my ( $dbh, $biblioitem ) = @_;
3033 my ($cn_sort) = GetClassSort( $biblioitem->{'biblioitems.cn_source'}, $biblioitem->{'cn_class'}, $biblioitem->{'cn_item'} );
3034 my $query = "INSERT INTO biblioitems SET
3041 publicationyear = ?,
3045 collectiontitle = ?,
3047 collectionvolume= ?,
3048 editionstatement= ?,
3049 editionresponsibility = ?,
3065 my $sth = $dbh->prepare($query);
3067 $biblioitem->{'biblionumber'}, $biblioitem->{'volume'}, $biblioitem->{'number'}, $biblioitem->{'itemtype'},
3068 $biblioitem->{'isbn'}, $biblioitem->{'issn'}, $biblioitem->{'publicationyear'}, $biblioitem->{'publishercode'},
3069 $biblioitem->{'volumedate'}, $biblioitem->{'volumedesc'}, $biblioitem->{'collectiontitle'}, $biblioitem->{'collectionissn'},
3070 $biblioitem->{'collectionvolume'}, $biblioitem->{'editionstatement'}, $biblioitem->{'editionresponsibility'}, $biblioitem->{'illus'},
3071 $biblioitem->{'pages'}, $biblioitem->{'bnotes'}, $biblioitem->{'size'}, $biblioitem->{'place'},
3072 $biblioitem->{'lccn'}, $biblioitem->{'marc'}, $biblioitem->{'url'}, $biblioitem->{'biblioitems.cn_source'},
3073 $biblioitem->{'cn_class'}, $biblioitem->{'cn_item'}, $biblioitem->{'cn_suffix'}, $cn_sort,
3074 $biblioitem->{'totalissues'}
3076 my $bibitemnum = $dbh->{'mysql_insertid'};
3078 if ( $dbh->errstr ) {
3079 $error .= "ERROR in _koha_add_biblioitem $query" . $dbh->errstr;
3083 return ( $bibitemnum, $error );
3086 =head2 _koha_delete_biblio
3088 $error = _koha_delete_biblio($dbh,$biblionumber);
3090 Internal sub for deleting from biblio table -- also saves to deletedbiblio
3092 C<$dbh> - the database handle
3094 C<$biblionumber> - the biblionumber of the biblio to be deleted
3098 # FIXME: add error handling
3100 sub _koha_delete_biblio {
3101 my ( $dbh, $biblionumber ) = @_;
3103 # get all the data for this biblio
3104 my $sth = $dbh->prepare("SELECT * FROM biblio WHERE biblionumber=?");
3105 $sth->execute($biblionumber);
3107 if ( my $data = $sth->fetchrow_hashref ) {
3109 # save the record in deletedbiblio
3110 # find the fields to save
3111 my $query = "INSERT INTO deletedbiblio SET ";
3113 foreach my $temp ( keys %$data ) {
3114 $query .= "$temp = ?,";
3115 push( @bind, $data->{$temp} );
3118 # replace the last , by ",?)"
3120 my $bkup_sth = $dbh->prepare($query);
3121 $bkup_sth->execute(@bind);
3125 my $del_sth = $dbh->prepare("DELETE FROM biblio WHERE biblionumber=?");
3126 $del_sth->execute($biblionumber);
3133 =head2 _koha_delete_biblioitems
3135 $error = _koha_delete_biblioitems($dbh,$biblioitemnumber);
3137 Internal sub for deleting from biblioitems table -- also saves to deletedbiblioitems
3139 C<$dbh> - the database handle
3140 C<$biblionumber> - the biblioitemnumber of the biblioitem to be deleted
3144 # FIXME: add error handling
3146 sub _koha_delete_biblioitems {
3147 my ( $dbh, $biblioitemnumber ) = @_;
3149 # get all the data for this biblioitem
3150 my $sth = $dbh->prepare("SELECT * FROM biblioitems WHERE biblioitemnumber=?");
3151 $sth->execute($biblioitemnumber);
3153 if ( my $data = $sth->fetchrow_hashref ) {
3155 # save the record in deletedbiblioitems
3156 # find the fields to save
3157 my $query = "INSERT INTO deletedbiblioitems SET ";
3159 foreach my $temp ( keys %$data ) {
3160 $query .= "$temp = ?,";
3161 push( @bind, $data->{$temp} );
3164 # replace the last , by ",?)"
3166 my $bkup_sth = $dbh->prepare($query);
3167 $bkup_sth->execute(@bind);
3170 # delete the biblioitem
3171 my $del_sth = $dbh->prepare("DELETE FROM biblioitems WHERE biblioitemnumber=?");
3172 $del_sth->execute($biblioitemnumber);
3179 =head1 UNEXPORTED FUNCTIONS
3181 =head2 ModBiblioMarc
3183 &ModBiblioMarc($newrec,$biblionumber,$frameworkcode);
3185 Add MARC data for a biblio to koha
3187 Function exported, but should NOT be used, unless you really know what you're doing
3193 # pass the MARC::Record to this function, and it will create the records in the marc field
3194 my ( $record, $biblionumber, $frameworkcode ) = @_;
3195 my $dbh = C4::Context->dbh;
3196 my @fields = $record->fields();
3197 if ( !$frameworkcode ) {
3198 $frameworkcode = "";
3200 my $sth = $dbh->prepare("UPDATE biblio SET frameworkcode=? WHERE biblionumber=?");
3201 $sth->execute( $frameworkcode, $biblionumber );
3203 my $encoding = C4::Context->preference("marcflavour");
3205 # deal with UNIMARC field 100 (encoding) : create it if needed & set encoding to unicode
3206 if ( $encoding eq "UNIMARC" ) {
3207 my $string = $record->subfield( 100, "a" );
3208 if ( ($string) && ( length( $record->subfield( 100, "a" ) ) == 36 ) ) {
3209 my $f100 = $record->field(100);
3210 $record->delete_field($f100);
3212 $string = POSIX::strftime( "%Y%m%d", localtime );
3214 $string = sprintf( "%-*s", 35, $string );
3216 substr( $string, 22, 6, "frey50" );
3217 unless ( $record->subfield( 100, "a" ) ) {
3218 $record->insert_grouped_field( MARC::Field->new( 100, "", "", "a" => $string ) );
3222 if ( C4::Context->preference("NoZebra") ) {
3224 # only NoZebra indexing needs to have
3225 # the previous version of the record
3226 $oldRecord = GetMarcBiblio($biblionumber);
3228 $sth = $dbh->prepare("UPDATE biblioitems SET marc=?,marcxml=? WHERE biblionumber=?");
3229 $sth->execute( $record->as_usmarc(), $record->as_xml_record($encoding), $biblionumber );
3231 ModZebra( $biblionumber, "specialUpdate", "biblioserver", $oldRecord, $record );
3232 return $biblionumber;
3235 =head2 z3950_extended_services
3237 z3950_extended_services($serviceType,$serviceOptions,$record);
3239 z3950_extended_services is used to handle all interactions with Zebra's extended serices package, which is employed to perform all management of the MARC data stored in Zebra.
3241 C<$serviceType> one of: itemorder,create,drop,commit,update,xmlupdate
3243 C<$serviceOptions> a has of key/value pairs. For instance, if service_type is 'update', $service_options should contain:
3245 action => update action, one of specialUpdate, recordInsert, recordReplace, recordDelete, elementUpdate.
3249 recordidOpaque => Opaque Record ID (user supplied) or recordidNumber => Record ID number (system number).
3250 syntax => the record syntax (transfer syntax)
3251 databaseName = Database from connection object
3253 To set serviceOptions, call set_service_options($serviceType)
3255 C<$record> the record, if one is needed for the service type
3257 A record should be in XML. You can convert it to XML from MARC by running it through marc2xml().
3261 sub z3950_extended_services {
3262 my ( $server, $serviceType, $action, $serviceOptions ) = @_;
3264 # get our connection object
3265 my $Zconn = C4::Context->Zconn( $server, 0, 1 );
3267 # create a new package object
3268 my $Zpackage = $Zconn->package();
3271 $Zpackage->option( action => $action );
3273 if ( $serviceOptions->{'databaseName'} ) {
3274 $Zpackage->option( databaseName => $serviceOptions->{'databaseName'} );
3276 if ( $serviceOptions->{'recordIdNumber'} ) {
3277 $Zpackage->option( recordIdNumber => $serviceOptions->{'recordIdNumber'} );
3279 if ( $serviceOptions->{'recordIdOpaque'} ) {
3280 $Zpackage->option( recordIdOpaque => $serviceOptions->{'recordIdOpaque'} );
3283 # this is an ILL request (Zebra doesn't support it, but Koha could eventually)
3284 #if ($serviceType eq 'itemorder') {
3285 # $Zpackage->option('contact-name' => $serviceOptions->{'contact-name'});
3286 # $Zpackage->option('contact-phone' => $serviceOptions->{'contact-phone'});
3287 # $Zpackage->option('contact-email' => $serviceOptions->{'contact-email'});
3288 # $Zpackage->option('itemorder-item' => $serviceOptions->{'itemorder-item'});
3291 if ( $serviceOptions->{record} ) {
3292 $Zpackage->option( record => $serviceOptions->{record} );
3294 # can be xml or marc
3295 if ( $serviceOptions->{'syntax'} ) {
3296 $Zpackage->option( syntax => $serviceOptions->{'syntax'} );
3300 # send the request, handle any exception encountered
3301 eval { $Zpackage->send($serviceType) };
3302 if ( $@ && $@->isa("ZOOM::Exception") ) {
3303 return "error: " . $@->code() . " " . $@->message() . "\n";
3306 # free up package resources
3307 $Zpackage->destroy();
3310 =head2 set_service_options
3312 my $serviceOptions = set_service_options($serviceType);
3314 C<$serviceType> itemorder,create,drop,commit,update,xmlupdate
3316 Currently, we only support 'create', 'commit', and 'update'. 'drop' support will be added as soon as Zebra supports it.
3320 sub set_service_options {
3321 my ($serviceType) = @_;
3324 # FIXME: This needs to be an OID ... if we ever need 'syntax' this sub will need to change
3325 # $serviceOptions->{ 'syntax' } = ''; #zebra doesn't support syntaxes other than xml
3327 if ( $serviceType eq 'commit' ) {
3331 if ( $serviceType eq 'create' ) {
3335 if ( $serviceType eq 'drop' ) {
3336 die "ERROR: 'drop' not currently supported (by Zebra)";
3338 return $serviceOptions;
3341 =head2 get_biblio_authorised_values
3343 find the types and values for all authorised values assigned to this biblio.
3347 MARC::Record of the bib
3349 returns: a hashref mapping the authorised value to the value set for this biblionumber
3351 $authorised_values = {
3352 'Scent' => 'flowery',
3353 'Audience' => 'Young Adult',
3354 'itemtypes' => 'SER',
3357 Notes: forlibrarian should probably be passed in, and called something different.
3361 sub get_biblio_authorised_values {
3362 my $biblionumber = shift;
3365 my $forlibrarian = 1; # are we in staff or opac?
3366 my $frameworkcode = GetFrameworkCode($biblionumber);
3368 my $authorised_values;
3370 my $tagslib = GetMarcStructure( $forlibrarian, $frameworkcode )
3371 or return $authorised_values;
3373 # assume that these entries in the authorised_value table are bibliolevel.
3374 # ones that start with 'item%' are item level.
3375 my $query = q(SELECT distinct authorised_value, kohafield
3376 FROM marc_subfield_structure
3377 WHERE authorised_value !=''
3378 AND (kohafield like 'biblio%'
3379 OR kohafield like '') );
3380 my $bibliolevel_authorised_values = C4::Context->dbh->selectall_hashref( $query, 'authorised_value' );
3382 foreach my $tag ( keys(%$tagslib) ) {
3383 foreach my $subfield ( keys( %{ $tagslib->{$tag} } ) ) {
3385 # warn "checking $subfield. type is: " . ref $tagslib->{ $tag }{ $subfield };
3386 if ( 'HASH' eq ref $tagslib->{$tag}{$subfield} ) {
3387 if ( defined $tagslib->{$tag}{$subfield}{'authorised_value'} && exists $bibliolevel_authorised_values->{ $tagslib->{$tag}{$subfield}{'authorised_value'} } ) {
3388 if ( defined $record->field($tag) ) {
3389 my $this_subfield_value = $record->field($tag)->subfield($subfield);
3390 if ( defined $this_subfield_value ) {
3391 $authorised_values->{ $tagslib->{$tag}{$subfield}{'authorised_value'} } = $this_subfield_value;
3399 # warn ( Data::Dumper->Dump( [ $authorised_values ], [ 'authorised_values' ] ) );
3400 return $authorised_values;
3409 Koha Development Team <http://koha-community.org/>
3411 Paul POULAIN paul.poulain@free.fr
3413 Joshua Ferraro jmf@liblime.com