3 # Copyright 2000-2002 Katipo Communications
4 # Copyright 2010 BibLibre
5 # Copyright 2011 Equinox Software, Inc.
7 # This file is part of Koha.
9 # Koha is free software; you can redistribute it and/or modify it
10 # under the terms of the GNU General Public License as published by
11 # the Free Software Foundation; either version 3 of the License, or
12 # (at your option) any later version.
14 # Koha is distributed in the hope that it will be useful, but
15 # WITHOUT ANY WARRANTY; without even the implied warranty of
16 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17 # GNU General Public License for more details.
19 # You should have received a copy of the GNU General Public License
20 # along with Koha; if not, see <http://www.gnu.org/licenses>.
25 use Encode qw( decode is_utf8 );
27 use MARC::File::USMARC;
29 use POSIX qw(strftime);
30 use Module::Load::Conditional qw(can_load);
33 use C4::Log; # logaction
42 use Koha::Authority::Types;
43 use Koha::Acquisition::Currencies;
44 use Koha::Biblio::Metadata;
45 use Koha::Biblio::Metadatas;
46 use Koha::SearchEngine;
49 use vars qw(@ISA @EXPORT);
50 use vars qw($debug $cgi_debug);
55 @ISA = qw( Exporter );
70 GetBiblioItemByBiblioNumber
71 GetBiblioFromItemNumber
72 GetBiblionumberFromItemnumber
97 &GetAuthorisedValueDesc
99 &IsMarcStructureInternal
100 &GetMarcFromKohaField
101 &GetMarcSubfieldStructureFromKohaField
111 # To modify something
119 # To delete something
124 # To link headings in a bib record
125 # to authority records.
128 &LinkBibHeadingsToAuthorities
132 # those functions are exported but should not be used
133 # they are useful in a few circumstances, so they are exported,
134 # but don't use them unless you are a core developer ;-)
150 C4::Biblio - cataloging management functions
154 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:
158 =item 1. in the biblio,biblioitems,items, etc tables, which are limited to a one-to-one mapping to underlying MARC data
160 =item 2. as raw MARC in the Zebra index and storage engine
162 =item 3. as MARC XML in biblio_metadata.metadata
166 In the 3.0 version of Koha, the authoritative record-level information is in biblio_metadata.metadata
168 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.
172 =item 1. Compared with MySQL, Zebra is slow to update an index for small data changes -- especially for proc-intensive operations like circulation
174 =item 2. Zebra's index has been known to crash and a backup of the data is necessary to rebuild it in such cases
178 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:
182 =item 1. Add*/Mod*/Del*/ - high-level external functions suitable for being called from external scripts to manage the collection
184 =item 2. _koha_* - low-level internal functions for managing the koha tables
186 =item 3. Marc management function : as the MARC record is stored in biblio_metadata.metadata, 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.
188 =item 4. Zebra functions used to update the Zebra index
190 =item 5. internal helper functions such as char_decode, checkitems, etc. Some of these probably belong in Koha.pm
194 The MARC record (in biblio_metadata.metadata) 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 :
198 =item 1. save datas in biblio and biblioitems table, that gives us a biblionumber and a biblioitemnumber
200 =item 2. add the biblionumber and biblioitemnumber into the MARC records
202 =item 3. save the marc record
206 =head1 EXPORTED FUNCTIONS
210 ($biblionumber,$biblioitemnumber) = AddBiblio($record,$frameworkcode);
212 Exported function (core API) for adding a new biblio to koha.
214 The first argument is a C<MARC::Record> object containing the
215 bib to add, while the second argument is the desired MARC
218 This function also accepts a third, optional argument: a hashref
219 to additional options. The only defined option is C<defer_marc_save>,
220 which if present and mapped to a true value, causes C<AddBiblio>
221 to omit the call to save the MARC in C<biblio_metadata.metadata>
222 This option is provided B<only>
223 for the use of scripts such as C<bulkmarcimport.pl> that may need
224 to do some manipulation of the MARC record for item parsing before
225 saving it and which cannot afford the performance hit of saving
226 the MARC record twice. Consequently, do not use that option
227 unless you can guarantee that C<ModBiblioMarc> will be called.
233 my $frameworkcode = shift;
234 my $options = @_ ? shift : undef;
235 my $defer_marc_save = 0;
237 carp('AddBiblio called with undefined record');
240 if ( defined $options and exists $options->{'defer_marc_save'} and $options->{'defer_marc_save'} ) {
241 $defer_marc_save = 1;
244 my ( $biblionumber, $biblioitemnumber, $error );
245 my $dbh = C4::Context->dbh;
247 # transform the data into koha-table style data
248 SetUTF8Flag($record);
249 my $olddata = TransformMarcToKoha( $record, $frameworkcode );
250 ( $biblionumber, $error ) = _koha_add_biblio( $dbh, $olddata, $frameworkcode );
251 $olddata->{'biblionumber'} = $biblionumber;
252 ( $biblioitemnumber, $error ) = _koha_add_biblioitem( $dbh, $olddata );
254 _koha_marc_update_bib_ids( $record, $frameworkcode, $biblionumber, $biblioitemnumber );
256 # update MARC subfield that stores biblioitems.cn_sort
257 _koha_marc_update_biblioitem_cn_sort( $record, $olddata, $frameworkcode );
260 ModBiblioMarc( $record, $biblionumber, $frameworkcode ) unless $defer_marc_save;
262 # update OAI-PMH sets
263 if(C4::Context->preference("OAI-PMH:AutoUpdateSets")) {
264 C4::OAI::Sets::UpdateOAISetsBiblio($biblionumber, $record);
267 logaction( "CATALOGUING", "ADD", $biblionumber, "biblio" ) if C4::Context->preference("CataloguingLog");
268 return ( $biblionumber, $biblioitemnumber );
273 ModBiblio( $record,$biblionumber,$frameworkcode);
275 Replace an existing bib record identified by C<$biblionumber>
276 with one supplied by the MARC::Record object C<$record>. The embedded
277 item, biblioitem, and biblionumber fields from the previous
278 version of the bib record replace any such fields of those tags that
279 are present in C<$record>. Consequently, ModBiblio() is not
280 to be used to try to modify item records.
282 C<$frameworkcode> specifies the MARC framework to use
283 when storing the modified bib record; among other things,
284 this controls how MARC fields get mapped to display columns
285 in the C<biblio> and C<biblioitems> tables, as well as
286 which fields are used to store embedded item, biblioitem,
287 and biblionumber data for indexing.
289 Returns 1 on success 0 on failure
294 my ( $record, $biblionumber, $frameworkcode ) = @_;
296 carp 'No record passed to ModBiblio';
300 if ( C4::Context->preference("CataloguingLog") ) {
301 my $newrecord = GetMarcBiblio($biblionumber);
302 logaction( "CATALOGUING", "MODIFY", $biblionumber, "biblio BEFORE=>" . $newrecord->as_formatted );
305 # Cleaning up invalid fields must be done early or SetUTF8Flag is liable to
306 # throw an exception which probably won't be handled.
307 foreach my $field ($record->fields()) {
308 if (! $field->is_control_field()) {
309 if (scalar($field->subfields()) == 0 || (scalar($field->subfields()) == 1 && $field->subfield('9'))) {
310 $record->delete_field($field);
315 SetUTF8Flag($record);
316 my $dbh = C4::Context->dbh;
318 $frameworkcode = "" if !$frameworkcode || $frameworkcode eq "Default"; # XXX
320 _strip_item_fields($record, $frameworkcode);
322 # update biblionumber and biblioitemnumber in MARC
323 # FIXME - this is assuming a 1 to 1 relationship between
324 # biblios and biblioitems
325 my $sth = $dbh->prepare("select biblioitemnumber from biblioitems where biblionumber=?");
326 $sth->execute($biblionumber);
327 my ($biblioitemnumber) = $sth->fetchrow;
329 _koha_marc_update_bib_ids( $record, $frameworkcode, $biblionumber, $biblioitemnumber );
331 # load the koha-table data object
332 my $oldbiblio = TransformMarcToKoha( $record, $frameworkcode );
334 # update MARC subfield that stores biblioitems.cn_sort
335 _koha_marc_update_biblioitem_cn_sort( $record, $oldbiblio, $frameworkcode );
337 # update the MARC record (that now contains biblio and items) with the new record data
338 &ModBiblioMarc( $record, $biblionumber, $frameworkcode );
340 # modify the other koha tables
341 _koha_modify_biblio( $dbh, $oldbiblio, $frameworkcode );
342 _koha_modify_biblioitem_nonmarc( $dbh, $oldbiblio );
344 # update OAI-PMH sets
345 if(C4::Context->preference("OAI-PMH:AutoUpdateSets")) {
346 C4::OAI::Sets::UpdateOAISetsBiblio($biblionumber, $record);
352 =head2 _strip_item_fields
354 _strip_item_fields($record, $frameworkcode)
356 Utility routine to remove item tags from a
361 sub _strip_item_fields {
363 my $frameworkcode = shift;
364 # get the items before and append them to the biblio before updating the record, atm we just have the biblio
365 my ( $itemtag, $itemsubfield ) = GetMarcFromKohaField( "items.itemnumber", $frameworkcode );
367 # delete any item fields from incoming record to avoid
368 # duplication or incorrect data - use AddItem() or ModItem()
370 foreach my $field ( $record->field($itemtag) ) {
371 $record->delete_field($field);
377 my $error = &DelBiblio($biblionumber);
379 Exported function (core API) for deleting a biblio in koha.
380 Deletes biblio record from Zebra and Koha tables (biblio & biblioitems)
381 Also backs it up to deleted* tables.
382 Checks to make sure that the biblio has no items attached.
384 C<$error> : undef unless an error occurs
389 my ($biblionumber) = @_;
390 my $dbh = C4::Context->dbh;
391 my $error; # for error handling
393 # First make sure this biblio has no items attached
394 my $sth = $dbh->prepare("SELECT itemnumber FROM items WHERE biblionumber=?");
395 $sth->execute($biblionumber);
396 if ( my $itemnumber = $sth->fetchrow ) {
398 # Fix this to use a status the template can understand
399 $error .= "This Biblio has items attached, please delete them first before deleting this biblio ";
402 return $error if $error;
404 # We delete attached subscriptions
406 my $subscriptions = C4::Serials::GetFullSubscriptionsFromBiblionumber($biblionumber);
407 foreach my $subscription (@$subscriptions) {
408 C4::Serials::DelSubscription( $subscription->{subscriptionid} );
411 # We delete any existing holds
412 require C4::Reserves;
413 my $reserves = C4::Reserves::GetReservesFromBiblionumber({ biblionumber => $biblionumber });
414 foreach my $res ( @$reserves ) {
415 C4::Reserves::CancelReserve({ reserve_id => $res->{'reserve_id'} });
418 # Delete in Zebra. Be careful NOT to move this line after _koha_delete_biblio
419 # for at least 2 reasons :
420 # - if something goes wrong, the biblio may be deleted from Koha but not from zebra
421 # 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)
422 ModZebra( $biblionumber, "recordDelete", "biblioserver" );
424 # delete biblioitems and items from Koha tables and save in deletedbiblioitems,deleteditems
425 $sth = $dbh->prepare("SELECT biblioitemnumber FROM biblioitems WHERE biblionumber=?");
426 $sth->execute($biblionumber);
427 while ( my $biblioitemnumber = $sth->fetchrow ) {
429 # delete this biblioitem
430 $error = _koha_delete_biblioitems( $dbh, $biblioitemnumber );
431 return $error if $error;
435 # delete biblio from Koha tables and save in deletedbiblio
436 # must do this *after* _koha_delete_biblioitems, otherwise
437 # delete cascade will prevent deletedbiblioitems rows
438 # from being generated by _koha_delete_biblioitems
439 $error = _koha_delete_biblio( $dbh, $biblionumber );
441 logaction( "CATALOGUING", "DELETE", $biblionumber, "biblio" ) if C4::Context->preference("CataloguingLog");
447 =head2 BiblioAutoLink
449 my $headings_linked = BiblioAutoLink($record, $frameworkcode)
451 Automatically links headings in a bib record to authorities.
453 Returns the number of headings changed
459 my $frameworkcode = shift;
461 carp('Undefined record passed to BiblioAutoLink');
464 my ( $num_headings_changed, %results );
467 "C4::Linker::" . ( C4::Context->preference("LinkerModule") || 'Default' );
468 unless ( can_load( modules => { $linker_module => undef } ) ) {
469 $linker_module = 'C4::Linker::Default';
470 unless ( can_load( modules => { $linker_module => undef } ) ) {
475 my $linker = $linker_module->new(
476 { 'options' => C4::Context->preference("LinkerOptions") } );
477 my ( $headings_changed, undef ) =
478 LinkBibHeadingsToAuthorities( $linker, $record, $frameworkcode, C4::Context->preference("CatalogModuleRelink") || '' );
479 # By default we probably don't want to relink things when cataloging
480 return $headings_changed;
483 =head2 LinkBibHeadingsToAuthorities
485 my $num_headings_changed, %results = LinkBibHeadingsToAuthorities($linker, $marc, $frameworkcode, [$allowrelink]);
487 Links bib headings to authority records by checking
488 each authority-controlled field in the C<MARC::Record>
489 object C<$marc>, looking for a matching authority record,
490 and setting the linking subfield $9 to the ID of that
493 If $allowrelink is false, existing authids will never be
494 replaced, regardless of the values of LinkerKeepStale and
497 Returns the number of heading links changed in the
502 sub LinkBibHeadingsToAuthorities {
505 my $frameworkcode = shift;
506 my $allowrelink = shift;
509 carp 'LinkBibHeadingsToAuthorities called on undefined bib record';
513 require C4::AuthoritiesMarc;
515 $allowrelink = 1 unless defined $allowrelink;
516 my $num_headings_changed = 0;
517 foreach my $field ( $bib->fields() ) {
518 my $heading = C4::Heading->new_from_bib_field( $field, $frameworkcode );
519 next unless defined $heading;
522 my $current_link = $field->subfield('9');
524 if ( defined $current_link && (!$allowrelink || !C4::Context->preference('LinkerRelink')) )
526 $results{'linked'}->{ $heading->display_form() }++;
530 my ( $authid, $fuzzy ) = $linker->get_link($heading);
532 $results{ $fuzzy ? 'fuzzy' : 'linked' }
533 ->{ $heading->display_form() }++;
534 next if defined $current_link and $current_link == $authid;
536 $field->delete_subfield( code => '9' ) if defined $current_link;
537 $field->add_subfields( '9', $authid );
538 $num_headings_changed++;
541 if ( defined $current_link
542 && (!$allowrelink || C4::Context->preference('LinkerKeepStale')) )
544 $results{'fuzzy'}->{ $heading->display_form() }++;
546 elsif ( C4::Context->preference('AutoCreateAuthorities') ) {
547 if ( _check_valid_auth_link( $current_link, $field ) ) {
548 $results{'linked'}->{ $heading->display_form() }++;
551 my $authority_type = Koha::Authority::Types->find( $heading->auth_type() );
552 my $marcrecordauth = MARC::Record->new();
553 if ( C4::Context->preference('marcflavour') eq 'MARC21' ) {
554 $marcrecordauth->leader(' nz a22 o 4500');
555 SetMarcUnicodeFlag( $marcrecordauth, 'MARC21' );
557 $field->delete_subfield( code => '9' )
558 if defined $current_link;
560 MARC::Field->new( $authority_type->auth_tag_to_report,
561 '', '', "a" => "" . $field->subfield('a') );
563 $authfield->add_subfields( $_->[0] => $_->[1] )
564 if ( $_->[0] =~ /[A-z]/ && $_->[0] ne "a" )
565 } $field->subfields();
566 $marcrecordauth->insert_fields_ordered($authfield);
568 # bug 2317: ensure new authority knows it's using UTF-8; currently
569 # only need to do this for MARC21, as MARC::Record->as_xml_record() handles
570 # automatically for UNIMARC (by not transcoding)
571 # FIXME: AddAuthority() instead should simply explicitly require that the MARC::Record
572 # use UTF-8, but as of 2008-08-05, did not want to introduce that kind
573 # of change to a core API just before the 3.0 release.
575 if ( C4::Context->preference('marcflavour') eq 'MARC21' ) {
576 $marcrecordauth->insert_fields_ordered(
579 'a' => "Machine generated authority record."
583 $bib->author() . ", "
584 . $bib->title_proper() . ", "
585 . $bib->publication_date() . " ";
586 $cite =~ s/^[\s\,]*//;
587 $cite =~ s/[\s\,]*$//;
590 . C4::Context->preference('MARCOrgCode') . ")"
591 . $bib->subfield( '999', 'c' ) . ": "
593 $marcrecordauth->insert_fields_ordered(
594 MARC::Field->new( '670', '', '', 'a' => $cite ) );
597 # warn "AUTH RECORD ADDED : ".$marcrecordauth->as_formatted;
600 C4::AuthoritiesMarc::AddAuthority( $marcrecordauth, '',
601 $heading->auth_type() );
602 $field->add_subfields( '9', $authid );
603 $num_headings_changed++;
604 $linker->update_cache($heading, $authid);
605 $results{'added'}->{ $heading->display_form() }++;
608 elsif ( defined $current_link ) {
609 if ( _check_valid_auth_link( $current_link, $field ) ) {
610 $results{'linked'}->{ $heading->display_form() }++;
613 $field->delete_subfield( code => '9' );
614 $num_headings_changed++;
615 $results{'unlinked'}->{ $heading->display_form() }++;
619 $results{'unlinked'}->{ $heading->display_form() }++;
624 return $num_headings_changed, \%results;
627 =head2 _check_valid_auth_link
629 if ( _check_valid_auth_link($authid, $field) ) {
633 Check whether the specified heading-auth link is valid without reference
634 to Zebra. Ideally this code would be in C4::Heading, but that won't be
635 possible until we have de-cycled C4::AuthoritiesMarc, so this is the
640 sub _check_valid_auth_link {
641 my ( $authid, $field ) = @_;
643 require C4::AuthoritiesMarc;
645 my $authorized_heading =
646 C4::AuthoritiesMarc::GetAuthorizedHeading( { 'authid' => $authid } ) || '';
648 return ($field->as_string('abcdefghijklmnopqrstuvwxyz') eq $authorized_heading);
651 =head2 GetRecordValue
653 my $values = GetRecordValue($field, $record, $frameworkcode);
655 Get MARC fields from a keyword defined in fieldmapping table.
660 my ( $field, $record, $frameworkcode ) = @_;
663 carp 'GetRecordValue called with undefined record';
666 my $dbh = C4::Context->dbh;
668 my $sth = $dbh->prepare('SELECT fieldcode, subfieldcode FROM fieldmapping WHERE frameworkcode = ? AND field = ?');
669 $sth->execute( $frameworkcode, $field );
673 while ( my $row = $sth->fetchrow_hashref ) {
674 foreach my $field ( $record->field( $row->{fieldcode} ) ) {
675 if ( ( $row->{subfieldcode} ne "" && $field->subfield( $row->{subfieldcode} ) ) ) {
676 foreach my $subfield ( $field->subfield( $row->{subfieldcode} ) ) {
677 push @result, { 'subfield' => $subfield };
680 } elsif ( $row->{subfieldcode} eq "" ) {
681 push @result, { 'subfield' => $field->as_string() };
689 =head2 SetFieldMapping
691 SetFieldMapping($framework, $field, $fieldcode, $subfieldcode);
693 Set a Field to MARC mapping value, if it already exists we don't add a new one.
697 sub SetFieldMapping {
698 my ( $framework, $field, $fieldcode, $subfieldcode ) = @_;
699 my $dbh = C4::Context->dbh;
701 my $sth = $dbh->prepare('SELECT * FROM fieldmapping WHERE fieldcode = ? AND subfieldcode = ? AND frameworkcode = ? AND field = ?');
702 $sth->execute( $fieldcode, $subfieldcode, $framework, $field );
703 if ( not $sth->fetchrow_hashref ) {
705 $sth = $dbh->prepare('INSERT INTO fieldmapping (fieldcode, subfieldcode, frameworkcode, field) VALUES(?,?,?,?)');
707 $sth->execute( $fieldcode, $subfieldcode, $framework, $field );
711 =head2 DeleteFieldMapping
713 DeleteFieldMapping($id);
715 Delete a field mapping from an $id.
719 sub DeleteFieldMapping {
721 my $dbh = C4::Context->dbh;
723 my $sth = $dbh->prepare('DELETE FROM fieldmapping WHERE id = ?');
727 =head2 GetFieldMapping
729 GetFieldMapping($frameworkcode);
731 Get all field mappings for a specified frameworkcode
735 sub GetFieldMapping {
736 my ($framework) = @_;
737 my $dbh = C4::Context->dbh;
739 my $sth = $dbh->prepare('SELECT * FROM fieldmapping where frameworkcode = ?');
740 $sth->execute($framework);
743 while ( my $row = $sth->fetchrow_hashref ) {
751 $data = &GetBiblioData($biblionumber);
753 Returns information about the book with the given biblionumber.
754 C<&GetBiblioData> returns a reference-to-hash. The keys are the fields in
755 the C<biblio> and C<biblioitems> tables in the
758 In addition, C<$data-E<gt>{subject}> is the list of the book's
759 subjects, separated by C<" , "> (space, comma, space).
760 If there are multiple biblioitems with the given biblionumber, only
761 the first one is considered.
767 my $dbh = C4::Context->dbh;
769 my $query = " SELECT * , biblioitems.notes AS bnotes, itemtypes.notforloan as bi_notforloan, biblio.notes
771 LEFT JOIN biblioitems ON biblio.biblionumber = biblioitems.biblionumber
772 LEFT JOIN itemtypes ON biblioitems.itemtype = itemtypes.itemtype
773 WHERE biblio.biblionumber = ?";
775 my $sth = $dbh->prepare($query);
776 $sth->execute($bibnum);
778 $data = $sth->fetchrow_hashref;
782 } # sub GetBiblioData
784 =head2 &GetBiblioItemData
786 $itemdata = &GetBiblioItemData($biblioitemnumber);
788 Looks up the biblioitem with the given biblioitemnumber. Returns a
789 reference-to-hash. The keys are the fields from the C<biblio>,
790 C<biblioitems>, and C<itemtypes> tables in the Koha database, except
791 that C<biblioitems.notes> is given as C<$itemdata-E<gt>{bnotes}>.
796 sub GetBiblioItemData {
797 my ($biblioitemnumber) = @_;
798 my $dbh = C4::Context->dbh;
799 my $query = "SELECT *,biblioitems.notes AS bnotes
800 FROM biblio LEFT JOIN biblioitems on biblio.biblionumber=biblioitems.biblionumber ";
801 unless ( C4::Context->preference('item-level_itypes') ) {
802 $query .= "LEFT JOIN itemtypes on biblioitems.itemtype=itemtypes.itemtype ";
804 $query .= " WHERE biblioitemnumber = ? ";
805 my $sth = $dbh->prepare($query);
807 $sth->execute($biblioitemnumber);
808 $data = $sth->fetchrow_hashref;
811 } # sub &GetBiblioItemData
813 =head2 GetBiblioItemByBiblioNumber
815 NOTE : This function has been copy/paste from C4/Biblio.pm from head before zebra integration.
819 sub GetBiblioItemByBiblioNumber {
820 my ($biblionumber) = @_;
821 my $dbh = C4::Context->dbh;
822 my $sth = $dbh->prepare("Select * FROM biblioitems WHERE biblionumber = ?");
826 $sth->execute($biblionumber);
828 while ( my $data = $sth->fetchrow_hashref ) {
829 push @results, $data;
836 =head2 GetBiblionumberFromItemnumber
841 sub GetBiblionumberFromItemnumber {
842 my ($itemnumber) = @_;
843 my $dbh = C4::Context->dbh;
844 my $sth = $dbh->prepare("Select biblionumber FROM items WHERE itemnumber = ?");
846 $sth->execute($itemnumber);
847 my ($result) = $sth->fetchrow;
851 =head2 GetBiblioFromItemNumber
853 $item = &GetBiblioFromItemNumber($itemnumber,$barcode);
855 Looks up the item with the given itemnumber. if undef, try the barcode.
857 C<&itemnodata> returns a reference-to-hash whose keys are the fields
858 from the C<biblio>, C<biblioitems>, and C<items> tables in the Koha
864 sub GetBiblioFromItemNumber {
865 my ( $itemnumber, $barcode ) = @_;
866 my $dbh = C4::Context->dbh;
869 $sth = $dbh->prepare(
871 LEFT JOIN biblio ON biblio.biblionumber = items.biblionumber
872 LEFT JOIN biblioitems ON biblioitems.biblioitemnumber = items.biblioitemnumber
873 WHERE items.itemnumber = ?"
875 $sth->execute($itemnumber);
877 $sth = $dbh->prepare(
879 LEFT JOIN biblio ON biblio.biblionumber = items.biblionumber
880 LEFT JOIN biblioitems ON biblioitems.biblioitemnumber = items.biblioitemnumber
881 WHERE items.barcode = ?"
883 $sth->execute($barcode);
885 my $data = $sth->fetchrow_hashref;
892 $isbd = &GetISBDView({
893 'record' => $marc_record,
894 'template' => $interface, # opac/intranet
895 'framework' => $framework,
898 Return the ISBD view which can be included in opac and intranet
905 # Expecting record WITH items.
906 my $record = $params->{record};
907 return unless defined $record;
909 my $template = $params->{template} // q{};
910 my $sysprefname = $template eq 'opac' ? 'opacisbd' : 'isbd';
911 my $framework = $params->{framework};
912 my $itemtype = $framework;
913 my ( $holdingbrtagf, $holdingbrtagsubf ) = &GetMarcFromKohaField( "items.holdingbranch", $itemtype );
914 my $tagslib = &GetMarcStructure( 1, $itemtype, { unsafe => 1 } );
916 my $ISBD = C4::Context->preference($sysprefname);
921 foreach my $isbdfield ( split( /#/, $bloc ) ) {
923 # $isbdfield= /(.?.?.?)/;
924 $isbdfield =~ /(\d\d\d)([^\|])?\|(.*)\|(.*)\|(.*)/;
925 my $fieldvalue = $1 || 0;
926 my $subfvalue = $2 || "";
928 my $analysestring = $4;
931 # warn "==> $1 / $2 / $3 / $4";
932 # my $fieldvalue=substr($isbdfield,0,3);
933 if ( $fieldvalue > 0 ) {
934 my $hasputtextbefore = 0;
935 my @fieldslist = $record->field($fieldvalue);
936 @fieldslist = sort { $a->subfield($holdingbrtagsubf) cmp $b->subfield($holdingbrtagsubf) } @fieldslist if ( $fieldvalue eq $holdingbrtagf );
938 # warn "ERROR IN ISBD DEFINITION at : $isbdfield" unless $fieldvalue;
939 # warn "FV : $fieldvalue";
940 if ( $subfvalue ne "" ) {
941 # OPAC hidden subfield
943 if ( ( $template eq 'opac' )
944 && ( $tagslib->{$fieldvalue}->{$subfvalue}->{'hidden'} || 0 ) > 0 );
945 foreach my $field (@fieldslist) {
946 foreach my $subfield ( $field->subfield($subfvalue) ) {
947 my $calculated = $analysestring;
948 my $tag = $field->tag();
951 my $subfieldvalue = GetAuthorisedValueDesc( $tag, $subfvalue, $subfield, '', $tagslib );
952 my $tagsubf = $tag . $subfvalue;
953 $calculated =~ s/\{(.?.?.?.?)$tagsubf(.*?)\}/$1$subfieldvalue$2\{$1$tagsubf$2\}/g;
954 if ( $template eq "opac" ) { $calculated =~ s#/cgi-bin/koha/[^/]+/([^.]*.pl\?.*)$#opac-$1#g; }
956 # field builded, store the result
957 if ( $calculated && !$hasputtextbefore ) { # put textbefore if not done
958 $blocres .= $textbefore;
959 $hasputtextbefore = 1;
962 # remove punctuation at start
963 $calculated =~ s/^( |;|:|\.|-)*//g;
964 $blocres .= $calculated;
969 $blocres .= $textafter if $hasputtextbefore;
971 foreach my $field (@fieldslist) {
972 my $calculated = $analysestring;
973 my $tag = $field->tag();
976 my @subf = $field->subfields;
977 for my $i ( 0 .. $#subf ) {
978 my $valuecode = $subf[$i][1];
979 my $subfieldcode = $subf[$i][0];
980 # OPAC hidden subfield
982 if ( ( $template eq 'opac' )
983 && ( $tagslib->{$fieldvalue}->{$subfieldcode}->{'hidden'} || 0 ) > 0 );
984 my $subfieldvalue = GetAuthorisedValueDesc( $tag, $subf[$i][0], $subf[$i][1], '', $tagslib );
985 my $tagsubf = $tag . $subfieldcode;
987 $calculated =~ s/ # replace all {{}} codes by the value code.
988 \{\{$tagsubf\}\} # catch the {{actualcode}}
990 $valuecode # replace by the value code
993 $calculated =~ s/\{(.?.?.?.?)$tagsubf(.*?)\}/$1$subfieldvalue$2\{$1$tagsubf$2\}/g;
994 if ( $template eq "opac" ) { $calculated =~ s#/cgi-bin/koha/[^/]+/([^.]*.pl\?.*)$#opac-$1#g; }
997 # field builded, store the result
998 if ( $calculated && !$hasputtextbefore ) { # put textbefore if not done
999 $blocres .= $textbefore;
1000 $hasputtextbefore = 1;
1003 # remove punctuation at start
1004 $calculated =~ s/^( |;|:|\.|-)*//g;
1005 $blocres .= $calculated;
1008 $blocres .= $textafter if $hasputtextbefore;
1011 $blocres .= $isbdfield;
1016 $res =~ s/\{(.*?)\}//g;
1018 $res =~ s/\n/<br\/>/g;
1028 my $biblio = &GetBiblio($biblionumber);
1033 my ($biblionumber) = @_;
1034 my $dbh = C4::Context->dbh;
1035 my $sth = $dbh->prepare("SELECT * FROM biblio WHERE biblionumber = ?");
1038 $sth->execute($biblionumber);
1039 if ( my $data = $sth->fetchrow_hashref ) {
1045 =head2 GetBiblioItemInfosOf
1047 GetBiblioItemInfosOf(@biblioitemnumbers);
1051 sub GetBiblioItemInfosOf {
1052 my @biblioitemnumbers = @_;
1054 my $biblioitemnumber_values = @biblioitemnumbers ? join( ',', @biblioitemnumbers ) : "''";
1056 my $dbh = C4::Context->dbh;
1058 SELECT biblioitemnumber,
1062 WHERE biblioitemnumber IN ($biblioitemnumber_values)
1064 return $dbh->selectall_hashref($query, 'biblioitemnumber');
1067 =head1 FUNCTIONS FOR HANDLING MARC MANAGEMENT
1069 =head2 IsMarcStructureInternal
1071 my $tagslib = C4::Biblio::GetMarcStructure();
1072 for my $tag ( sort keys %$tagslib ) {
1074 for my $subfield ( sort keys %{ $tagslib->{$tag} } ) {
1075 next if IsMarcStructureInternal($tagslib->{$tag}{$subfield});
1080 GetMarcStructure creates keys (lib, tab, mandatory, repeatable) for a display purpose.
1081 These different values should not be processed as valid subfields.
1085 sub IsMarcStructureInternal {
1086 my ( $subfield ) = @_;
1087 return ref $subfield ? 0 : 1;
1090 =head2 GetMarcStructure
1092 $res = GetMarcStructure($forlibrarian, $frameworkcode, [ $params ]);
1094 Returns a reference to a big hash of hash, with the Marc structure for the given frameworkcode
1095 $forlibrarian :if set to 1, the MARC descriptions are the librarians ones, otherwise it's the public (OPAC) ones
1096 $frameworkcode : the framework code to read
1097 $params allows you to pass { unsafe => 1 } for better performance.
1099 Note: If you call GetMarcStructure with unsafe => 1, do not modify or
1100 even autovivify its contents. It is a cached/shared data structure. Your
1101 changes c/would be passed around in subsequent calls.
1105 sub GetMarcStructure {
1106 my ( $forlibrarian, $frameworkcode, $params ) = @_;
1107 $frameworkcode = "" unless $frameworkcode;
1109 $forlibrarian = $forlibrarian ? 1 : 0;
1110 my $unsafe = ($params && $params->{unsafe})? 1: 0;
1111 my $cache = Koha::Caches->get_instance();
1112 my $cache_key = "MarcStructure-$forlibrarian-$frameworkcode";
1113 my $cached = $cache->get_from_cache($cache_key, { unsafe => $unsafe });
1114 return $cached if $cached;
1116 my $dbh = C4::Context->dbh;
1117 my $sth = $dbh->prepare(
1118 "SELECT tagfield,liblibrarian,libopac,mandatory,repeatable
1119 FROM marc_tag_structure
1120 WHERE frameworkcode=?
1123 $sth->execute($frameworkcode);
1124 my ( $liblibrarian, $libopac, $tag, $res, $tab, $mandatory, $repeatable );
1126 while ( ( $tag, $liblibrarian, $libopac, $mandatory, $repeatable ) = $sth->fetchrow ) {
1127 $res->{$tag}->{lib} = ( $forlibrarian or !$libopac ) ? $liblibrarian : $libopac;
1128 $res->{$tag}->{tab} = "";
1129 $res->{$tag}->{mandatory} = $mandatory;
1130 $res->{$tag}->{repeatable} = $repeatable;
1133 $sth = $dbh->prepare(
1134 "SELECT tagfield,tagsubfield,liblibrarian,libopac,tab,mandatory,repeatable,authorised_value,authtypecode,value_builder,kohafield,seealso,hidden,isurl,link,defaultvalue,maxlength
1135 FROM marc_subfield_structure
1136 WHERE frameworkcode=?
1137 ORDER BY tagfield,tagsubfield
1141 $sth->execute($frameworkcode);
1144 my $authorised_value;
1156 ( $tag, $subfield, $liblibrarian, $libopac, $tab, $mandatory, $repeatable, $authorised_value,
1157 $authtypecode, $value_builder, $kohafield, $seealso, $hidden, $isurl, $link, $defaultvalue,
1162 $res->{$tag}->{$subfield}->{lib} = ( $forlibrarian or !$libopac ) ? $liblibrarian : $libopac;
1163 $res->{$tag}->{$subfield}->{tab} = $tab;
1164 $res->{$tag}->{$subfield}->{mandatory} = $mandatory;
1165 $res->{$tag}->{$subfield}->{repeatable} = $repeatable;
1166 $res->{$tag}->{$subfield}->{authorised_value} = $authorised_value;
1167 $res->{$tag}->{$subfield}->{authtypecode} = $authtypecode;
1168 $res->{$tag}->{$subfield}->{value_builder} = $value_builder;
1169 $res->{$tag}->{$subfield}->{kohafield} = $kohafield;
1170 $res->{$tag}->{$subfield}->{seealso} = $seealso;
1171 $res->{$tag}->{$subfield}->{hidden} = $hidden;
1172 $res->{$tag}->{$subfield}->{isurl} = $isurl;
1173 $res->{$tag}->{$subfield}->{'link'} = $link;
1174 $res->{$tag}->{$subfield}->{defaultvalue} = $defaultvalue;
1175 $res->{$tag}->{$subfield}->{maxlength} = $maxlength;
1178 $cache->set_in_cache($cache_key, $res);
1182 =head2 GetUsedMarcStructure
1184 The same function as GetMarcStructure except it just takes field
1185 in tab 0-9. (used field)
1187 my $results = GetUsedMarcStructure($frameworkcode);
1189 C<$results> is a ref to an array which each case containts a ref
1190 to a hash which each keys is the columns from marc_subfield_structure
1192 C<$frameworkcode> is the framework code.
1196 sub GetUsedMarcStructure {
1197 my $frameworkcode = shift || '';
1200 FROM marc_subfield_structure
1202 AND frameworkcode = ?
1203 ORDER BY tagfield, tagsubfield
1205 my $sth = C4::Context->dbh->prepare($query);
1206 $sth->execute($frameworkcode);
1207 return $sth->fetchall_arrayref( {} );
1210 =head2 GetMarcSubfieldStructure
1214 sub GetMarcSubfieldStructure {
1215 my ( $frameworkcode ) = @_;
1217 $frameworkcode //= '';
1219 my $cache = Koha::Caches->get_instance();
1220 my $cache_key = "MarcSubfieldStructure-$frameworkcode";
1221 my $cached = $cache->get_from_cache($cache_key);
1222 return $cached if $cached;
1224 my $dbh = C4::Context->dbh;
1225 my $subfield_structure = $dbh->selectall_hashref( q|
1227 FROM marc_subfield_structure
1228 WHERE frameworkcode = ?
1230 |, 'kohafield', {}, $frameworkcode );
1232 $cache->set_in_cache( $cache_key, $subfield_structure );
1233 return $subfield_structure;
1236 =head2 GetMarcFromKohaField
1238 ($MARCfield,$MARCsubfield)=GetMarcFromKohaField($kohafield,$frameworkcode);
1240 Returns the MARC fields & subfields mapped to the koha field
1241 for the given frameworkcode or default framework if $frameworkcode is missing
1245 sub GetMarcFromKohaField {
1246 my ( $kohafield, $frameworkcode ) = @_;
1247 return (0, undef) unless $kohafield;
1248 my $mss = GetMarcSubfieldStructure( $frameworkcode );
1249 return ( $mss->{$kohafield}{tagfield}, $mss->{$kohafield}{tagsubfield} );
1252 =head2 GetMarcSubfieldStructureFromKohaField
1254 my $subfield_structure = &GetMarcSubfieldStructureFromKohaField($kohafield, $frameworkcode);
1256 Returns a hashref where keys are marc_subfield_structure column names for the
1257 row where kohafield=$kohafield for the given framework code.
1259 $frameworkcode is optional. If not given, then the default framework is used.
1263 sub GetMarcSubfieldStructureFromKohaField {
1264 my ( $kohafield, $frameworkcode ) = @_;
1266 return unless $kohafield;
1268 my $mss = GetMarcSubfieldStructure( $frameworkcode );
1269 return exists $mss->{$kohafield}
1270 ? $mss->{$kohafield}
1274 =head2 GetMarcBiblio
1276 my $record = GetMarcBiblio($biblionumber, [$embeditems], [$opac]);
1278 Returns MARC::Record representing a biblio record, or C<undef> if the
1279 biblionumber doesn't exist.
1283 =item C<$biblionumber>
1287 =item C<$embeditems>
1289 set to true to include item information.
1293 set to true to make the result suited for OPAC view. This causes things like
1294 OpacHiddenItems to be applied.
1301 my $biblionumber = shift;
1302 my $embeditems = shift || 0;
1303 my $opac = shift || 0;
1305 if (not defined $biblionumber) {
1306 carp 'GetMarcBiblio called with undefined biblionumber';
1310 my $dbh = C4::Context->dbh;
1311 my $sth = $dbh->prepare("SELECT biblioitemnumber FROM biblioitems WHERE biblionumber=? ");
1312 $sth->execute($biblionumber);
1313 my $row = $sth->fetchrow_hashref;
1314 my $biblioitemnumber = $row->{'biblioitemnumber'};
1315 my $marcxml = GetXmlBiblio( $biblionumber );
1316 $marcxml = StripNonXmlChars( $marcxml );
1317 my $frameworkcode = GetFrameworkCode($biblionumber);
1318 MARC::File::XML->default_record_format( C4::Context->preference('marcflavour') );
1319 my $record = MARC::Record->new();
1323 MARC::Record::new_from_xml( $marcxml, "utf8",
1324 C4::Context->preference('marcflavour') );
1326 if ($@) { warn " problem with :$biblionumber : $@ \n$marcxml"; }
1327 return unless $record;
1329 C4::Biblio::_koha_marc_update_bib_ids( $record, $frameworkcode, $biblionumber,
1330 $biblioitemnumber );
1331 C4::Biblio::EmbedItemsInMarcBiblio( $record, $biblionumber, undef, $opac )
1343 my $marcxml = GetXmlBiblio($biblionumber);
1345 Returns biblio_metadata.metadata/marcxml of the biblionumber passed in parameter.
1346 The XML should only contain biblio information (item information is no longer stored in marcxml field)
1351 my ($biblionumber) = @_;
1352 my $dbh = C4::Context->dbh;
1353 return unless $biblionumber;
1354 my ($marcxml) = $dbh->selectrow_array(
1357 FROM biblio_metadata
1358 WHERE biblionumber=?
1359 AND format='marcxml'
1361 |, undef, $biblionumber, C4::Context->preference('marcflavour')
1366 =head2 GetCOinSBiblio
1368 my $coins = GetCOinSBiblio($record);
1370 Returns the COinS (a span) which can be included in a biblio record
1374 sub GetCOinSBiblio {
1377 # get the coin format
1379 carp 'GetCOinSBiblio called with undefined record';
1382 my $pos7 = substr $record->leader(), 7, 1;
1383 my $pos6 = substr $record->leader(), 6, 1;
1386 my ( $aulast, $aufirst ) = ( '', '' );
1395 my $titletype = 'b';
1397 # For the purposes of generating COinS metadata, LDR/06-07 can be
1398 # considered the same for UNIMARC and MARC21
1403 'b' => 'manuscript',
1405 'd' => 'manuscript',
1409 'i' => 'audioRecording',
1410 'j' => 'audioRecording',
1413 'm' => 'computerProgram',
1418 'a' => 'journalArticle',
1422 $genre = $fmts6->{$pos6} ? $fmts6->{$pos6} : 'book';
1424 if ( $genre eq 'book' ) {
1425 $genre = $fmts7->{$pos7} if $fmts7->{$pos7};
1428 ##### We must transform mtx to a valable mtx and document type ####
1429 if ( $genre eq 'book' ) {
1431 } elsif ( $genre eq 'journal' ) {
1434 } elsif ( $genre eq 'journalArticle' ) {
1442 $genre = ( $mtx eq 'dc' ) ? "&rft.type=$genre" : "&rft.genre=$genre";
1444 if ( C4::Context->preference("marcflavour") eq "UNIMARC" ) {
1447 $aulast = $record->subfield( '700', 'a' ) || '';
1448 $aufirst = $record->subfield( '700', 'b' ) || '';
1449 $oauthors = "&rft.au=$aufirst $aulast";
1452 if ( $record->field('200') ) {
1453 for my $au ( $record->field('200')->subfield('g') ) {
1454 $oauthors .= "&rft.au=$au";
1459 ? "&rft.title=" . $record->subfield( '200', 'a' )
1460 : "&rft.title=" . $record->subfield( '200', 'a' ) . "&rft.btitle=" . $record->subfield( '200', 'a' );
1461 $pubyear = $record->subfield( '210', 'd' ) || '';
1462 $publisher = $record->subfield( '210', 'c' ) || '';
1463 $isbn = $record->subfield( '010', 'a' ) || '';
1464 $issn = $record->subfield( '011', 'a' ) || '';
1467 # MARC21 need some improve
1470 if ( $record->field('100') ) {
1471 $oauthors .= "&rft.au=" . $record->subfield( '100', 'a' );
1475 if ( $record->field('700') ) {
1476 for my $au ( $record->field('700')->subfield('a') ) {
1477 $oauthors .= "&rft.au=$au";
1480 $title = "&rft." . $titletype . "title=" . $record->subfield( '245', 'a' );
1481 $subtitle = $record->subfield( '245', 'b' ) || '';
1482 $title .= $subtitle;
1483 if ($titletype eq 'a') {
1484 $pubyear = $record->field('008') || '';
1485 $pubyear = substr($pubyear->data(), 7, 4) if $pubyear;
1486 $isbn = $record->subfield( '773', 'z' ) || '';
1487 $issn = $record->subfield( '773', 'x' ) || '';
1488 if ($mtx eq 'journal') {
1489 $title .= "&rft.title=" . (($record->subfield( '773', 't' ) || $record->subfield( '773', 'a')));
1491 $title .= "&rft.btitle=" . (($record->subfield( '773', 't' ) || $record->subfield( '773', 'a')) || '');
1493 foreach my $rel ($record->subfield( '773', 'g' )) {
1500 $pubyear = $record->subfield( '260', 'c' ) || '';
1501 $publisher = $record->subfield( '260', 'b' ) || '';
1502 $isbn = $record->subfield( '020', 'a' ) || '';
1503 $issn = $record->subfield( '022', 'a' ) || '';
1508 "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&rft.pages=$pages";
1509 $coins_value =~ s/(\ |&[^a])/\+/g;
1510 $coins_value =~ s/\"/\"\;/g;
1512 #<!-- 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="
1514 return $coins_value;
1520 return the prices in accordance with the Marc format.
1522 returns 0 if no price found
1523 returns undef if called without a marc record or with
1524 an unrecognized marc format
1529 my ( $record, $marcflavour ) = @_;
1531 carp 'GetMarcPrice called on undefined record';
1538 if ( $marcflavour eq "MARC21" || $marcflavour eq "NORMARC" ) {
1539 @listtags = ('345', '020');
1541 } elsif ( $marcflavour eq "UNIMARC" ) {
1542 @listtags = ('345', '010');
1548 for my $field ( $record->field(@listtags) ) {
1549 for my $subfield_value ($field->subfield($subfield)){
1551 $subfield_value = MungeMarcPrice( $subfield_value );
1552 return $subfield_value if ($subfield_value);
1555 return 0; # no price found
1558 =head2 MungeMarcPrice
1560 Return the best guess at what the actual price is from a price field.
1563 sub MungeMarcPrice {
1565 return unless ( $price =~ m/\d/ ); ## No digits means no price.
1566 # Look for the currency symbol and the normalized code of the active currency, if it's there,
1567 my $active_currency = Koha::Acquisition::Currencies->get_active;
1568 my $symbol = $active_currency->symbol;
1569 my $isocode = $active_currency->isocode;
1570 $isocode = $active_currency->currency unless defined $isocode;
1573 my @matches =($price=~ /
1575 ( # start of capturing parenthesis
1577 (?:[\p{Sc}\p{L}\/.]){1,4} # any character from Currency signs or Letter Unicode categories or slash or dot within 1 to 4 occurrences : call this whole block 'symbol block'
1578 |(?:\d+[\p{P}\s]?){1,4} # or else at least one digit followed or not by a punctuation sign or whitespace, all these within 1 to 4 occurrences : call this whole block 'digits block'
1580 \s?\p{Sc}?\s? # followed or not by a whitespace. \p{Sc}?\s? are for cases like '25$ USD'
1582 (?:[\p{Sc}\p{L}\/.]){1,4} # followed by same block as symbol block
1583 |(?:\d+[\p{P}\s]?){1,4} # or by same block as digits block
1585 \s?\p{L}{0,4}\s? # followed or not by a whitespace. \p{L}{0,4}\s? are for cases like '$9.50 USD'
1586 ) # end of capturing parenthesis
1587 (?:\p{P}|\z) # followed by a punctuation sign or by the end of the string
1591 foreach ( @matches ) {
1592 $localprice = $_ and last if index($_, $isocode)>=0;
1594 if ( !$localprice ) {
1595 foreach ( @matches ) {
1596 $localprice = $_ and last if $_=~ /(^|[^\p{Sc}\p{L}\/])\Q$symbol\E([^\p{Sc}\p{L}\/]+\z|\z)/;
1601 if ( $localprice ) {
1602 $price = $localprice;
1604 ## Grab the first number in the string ( can use commas or periods for thousands separator and/or decimal separator )
1605 ( $price ) = $price =~ m/([\d\,\.]+[[\,\.]\d\d]?)/;
1607 # eliminate symbol/isocode, space and any final dot from the string
1608 $price =~ s/[\p{Sc}\p{L}\/ ]|\.$//g;
1609 # remove comma,dot when used as separators from hundreds
1610 $price =~s/[\,\.](\d{3})/$1/g;
1611 # convert comma to dot to ensure correct display of decimals if existing
1617 =head2 GetMarcQuantity
1619 return the quantity of a book. Used in acquisition only, when importing a file an iso2709 from a bookseller
1620 Warning : this is not really in the marc standard. In Unimarc, Electre (the most widely used bookseller) use the 969$a
1622 returns 0 if no quantity found
1623 returns undef if called without a marc record or with
1624 an unrecognized marc format
1628 sub GetMarcQuantity {
1629 my ( $record, $marcflavour ) = @_;
1631 carp 'GetMarcQuantity called on undefined record';
1638 if ( $marcflavour eq "MARC21" ) {
1640 } elsif ( $marcflavour eq "UNIMARC" ) {
1641 @listtags = ('969');
1647 for my $field ( $record->field(@listtags) ) {
1648 for my $subfield_value ($field->subfield($subfield)){
1650 if ($subfield_value) {
1651 # in France, the cents separator is the , but sometimes, ppl use a .
1652 # in this case, the price will be x100 when unformatted ! Replace the . by a , to get a proper price calculation
1653 $subfield_value =~ s/\./,/ if C4::Context->preference("CurrencyFormat") eq "FR";
1654 return $subfield_value;
1658 return 0; # no price found
1662 =head2 GetAuthorisedValueDesc
1664 my $subfieldvalue =get_authorised_value_desc(
1665 $tag, $subf[$i][0],$subf[$i][1], '', $taglib, $category, $opac);
1667 Retrieve the complete description for a given authorised value.
1669 Now takes $category and $value pair too.
1671 my $auth_value_desc =GetAuthorisedValueDesc(
1672 '','', 'DVD' ,'','','CCODE');
1674 If the optional $opac parameter is set to a true value, displays OPAC
1675 descriptions rather than normal ones when they exist.
1679 sub GetAuthorisedValueDesc {
1680 my ( $tag, $subfield, $value, $framework, $tagslib, $category, $opac ) = @_;
1684 return $value unless defined $tagslib->{$tag}->{$subfield}->{'authorised_value'};
1687 if ( $tagslib->{$tag}->{$subfield}->{'authorised_value'} eq "branches" ) {
1688 return Koha::Libraries->find($value)->branchname;
1692 if ( $tagslib->{$tag}->{$subfield}->{'authorised_value'} eq "itemtypes" ) {
1693 return getitemtypeinfo($value)->{translated_description};
1696 #---- "true" authorized value
1697 $category = $tagslib->{$tag}->{$subfield}->{'authorised_value'};
1700 my $dbh = C4::Context->dbh;
1701 if ( $category ne "" ) {
1702 my $sth = $dbh->prepare( "SELECT lib, lib_opac FROM authorised_values WHERE category = ? AND authorised_value = ?" );
1703 $sth->execute( $category, $value );
1704 my $data = $sth->fetchrow_hashref;
1705 return ( $opac && $data->{'lib_opac'} ) ? $data->{'lib_opac'} : $data->{'lib'};
1707 return $value; # if nothing is found return the original value
1711 =head2 GetMarcControlnumber
1713 $marccontrolnumber = GetMarcControlnumber($record,$marcflavour);
1715 Get the control number / record Identifier from the MARC record and return it.
1719 sub GetMarcControlnumber {
1720 my ( $record, $marcflavour ) = @_;
1722 carp 'GetMarcControlnumber called on undefined record';
1725 my $controlnumber = "";
1726 # Control number or Record identifier are the same field in MARC21, UNIMARC and NORMARC
1727 # Keep $marcflavour for possible later use
1728 if ($marcflavour eq "MARC21" || $marcflavour eq "UNIMARC" || $marcflavour eq "NORMARC") {
1729 my $controlnumberField = $record->field('001');
1730 if ($controlnumberField) {
1731 $controlnumber = $controlnumberField->data();
1734 return $controlnumber;
1739 $marcisbnsarray = GetMarcISBN( $record, $marcflavour );
1741 Get all ISBNs from the MARC record and returns them in an array.
1742 ISBNs stored in different fields depending on MARC flavour
1747 my ( $record, $marcflavour ) = @_;
1749 carp 'GetMarcISBN called on undefined record';
1753 if ( $marcflavour eq "UNIMARC" ) {
1755 } else { # assume marc21 if not unimarc
1760 foreach my $field ( $record->field($scope) ) {
1761 my $isbn = $field->subfield( 'a' );
1762 if ( $isbn ne "" ) {
1763 push @marcisbns, $isbn;
1773 $marcissnsarray = GetMarcISSN( $record, $marcflavour );
1775 Get all valid ISSNs from the MARC record and returns them in an array.
1776 ISSNs are stored in different fields depending on MARC flavour
1781 my ( $record, $marcflavour ) = @_;
1783 carp 'GetMarcISSN called on undefined record';
1787 if ( $marcflavour eq "UNIMARC" ) {
1790 else { # assume MARC21 or NORMARC
1794 foreach my $field ( $record->field($scope) ) {
1795 push @marcissns, $field->subfield( 'a' )
1796 if ( $field->subfield( 'a' ) ne "" );
1803 $marcnotesarray = GetMarcNotes( $record, $marcflavour );
1805 Get all notes from the MARC record and returns them in an array.
1806 The notes are stored in different fields depending on MARC flavour.
1807 MARC21 field 555 gets special attention for the $u subfields.
1812 my ( $record, $marcflavour ) = @_;
1814 carp 'GetMarcNotes called on undefined record';
1818 my $scope = $marcflavour eq "UNIMARC"? '3..': '5..';
1820 my %blacklist = map { $_ => 1 }
1821 split( /,/, C4::Context->preference('NotesBlacklist'));
1822 foreach my $field ( $record->field($scope) ) {
1823 my $tag = $field->tag();
1824 next if $blacklist{ $tag };
1825 if( $marcflavour ne 'UNIMARC' && $tag =~ /555/ ) {
1826 # Field 555$u contains URLs
1827 # We first push the regular subfields and all $u's separately
1828 # Leave further actions to the template
1829 push @marcnotes, { marcnote => $field->as_string('abcd') };
1830 foreach my $sub ( $field->subfield('u') ) {
1831 push @marcnotes, { marcnote => $sub };
1834 push @marcnotes, { marcnote => $field->as_string() };
1840 =head2 GetMarcSubjects
1842 $marcsubjcts = GetMarcSubjects($record,$marcflavour);
1844 Get all subjects from the MARC record and returns them in an array.
1845 The subjects are stored in different fields depending on MARC flavour
1849 sub GetMarcSubjects {
1850 my ( $record, $marcflavour ) = @_;
1852 carp 'GetMarcSubjects called on undefined record';
1855 my ( $mintag, $maxtag, $fields_filter );
1856 if ( $marcflavour eq "UNIMARC" ) {
1859 $fields_filter = '6..';
1860 } else { # marc21/normarc
1863 $fields_filter = '6..';
1868 my $subject_limit = C4::Context->preference("TraceCompleteSubfields") ? 'su,complete-subfield' : 'su';
1869 my $AuthoritySeparator = C4::Context->preference('AuthoritySeparator');
1871 foreach my $field ( $record->field($fields_filter) ) {
1872 next unless ($field->tag() >= $mintag && $field->tag() <= $maxtag);
1874 my @subfields = $field->subfields();
1877 # if there is an authority link, build the links with an= subfield9
1878 my $subfield9 = $field->subfield('9');
1881 my $linkvalue = $subfield9;
1882 $linkvalue =~ s/(\(|\))//g;
1883 @link_loop = ( { limit => 'an', 'link' => $linkvalue } );
1884 $authoritylink = $linkvalue
1888 for my $subject_subfield (@subfields) {
1889 next if ( $subject_subfield->[0] eq '9' );
1891 # don't load unimarc subfields 3,4,5
1892 next if ( ( $marcflavour eq "UNIMARC" ) and ( $subject_subfield->[0] =~ /2|3|4|5/ ) );
1893 # don't load MARC21 subfields 2 (FIXME: any more subfields??)
1894 next if ( ( $marcflavour eq "MARC21" ) and ( $subject_subfield->[0] =~ /2/ ) );
1896 my $code = $subject_subfield->[0];
1897 my $value = $subject_subfield->[1];
1898 my $linkvalue = $value;
1899 $linkvalue =~ s/(\(|\))//g;
1900 # if no authority link, build a search query
1901 unless ($subfield9) {
1903 limit => $subject_limit,
1904 'link' => $linkvalue,
1905 operator => (scalar @link_loop) ? ' and ' : undef
1908 my @this_link_loop = @link_loop;
1910 unless ( $code eq '0' ) {
1911 push @subfields_loop, {
1914 link_loop => \@this_link_loop,
1915 separator => (scalar @subfields_loop) ? $AuthoritySeparator : ''
1920 push @marcsubjects, {
1921 MARCSUBJECT_SUBFIELDS_LOOP => \@subfields_loop,
1922 authoritylink => $authoritylink,
1923 } if $authoritylink || @subfields_loop;
1926 return \@marcsubjects;
1927 } #end getMARCsubjects
1929 =head2 GetMarcAuthors
1931 authors = GetMarcAuthors($record,$marcflavour);
1933 Get all authors from the MARC record and returns them in an array.
1934 The authors are stored in different fields depending on MARC flavour
1938 sub GetMarcAuthors {
1939 my ( $record, $marcflavour ) = @_;
1941 carp 'GetMarcAuthors called on undefined record';
1944 my ( $mintag, $maxtag, $fields_filter );
1946 # tagslib useful only for UNIMARC author responsibilities
1948 if ( $marcflavour eq "UNIMARC" ) {
1949 # FIXME : we don't have the framework available, we take the default framework. May be buggy on some setups, will be usually correct.
1950 $tagslib = GetMarcStructure( 1, '', { unsafe => 1 });
1953 $fields_filter = '7..';
1954 } else { # marc21/normarc
1957 $fields_filter = '7..';
1961 my $AuthoritySeparator = C4::Context->preference('AuthoritySeparator');
1963 foreach my $field ( $record->field($fields_filter) ) {
1964 next unless $field->tag() >= $mintag && $field->tag() <= $maxtag;
1967 my @subfields = $field->subfields();
1970 # if there is an authority link, build the link with Koha-Auth-Number: subfield9
1971 my $subfield9 = $field->subfield('9');
1973 my $linkvalue = $subfield9;
1974 $linkvalue =~ s/(\(|\))//g;
1975 @link_loop = ( { 'limit' => 'an', 'link' => $linkvalue } );
1980 for my $authors_subfield (@subfields) {
1981 next if ( $authors_subfield->[0] eq '9' );
1983 # unimarc3 contains the $3 of the author for UNIMARC.
1984 # For french academic libraries, it's the "ppn", and it's required for idref webservice
1985 $unimarc3 = $authors_subfield->[1] if $marcflavour eq 'UNIMARC' and $authors_subfield->[0] =~ /3/;
1987 # don't load unimarc subfields 3, 5
1988 next if ( $marcflavour eq 'UNIMARC' and ( $authors_subfield->[0] =~ /3|5/ ) );
1990 my $code = $authors_subfield->[0];
1991 my $value = $authors_subfield->[1];
1992 my $linkvalue = $value;
1993 $linkvalue =~ s/(\(|\))//g;
1994 # UNIMARC author responsibility
1995 if ( $marcflavour eq 'UNIMARC' and $code eq '4' ) {
1996 $value = GetAuthorisedValueDesc( $field->tag(), $code, $value, '', $tagslib );
1997 $linkvalue = "($value)";
1999 # if no authority link, build a search query
2000 unless ($subfield9) {
2003 'link' => $linkvalue,
2004 operator => (scalar @link_loop) ? ' and ' : undef
2007 my @this_link_loop = @link_loop;
2009 unless ( $code eq '0') {
2010 push @subfields_loop, {
2011 tag => $field->tag(),
2014 link_loop => \@this_link_loop,
2015 separator => (scalar @subfields_loop) ? $AuthoritySeparator : ''
2019 push @marcauthors, {
2020 MARCAUTHOR_SUBFIELDS_LOOP => \@subfields_loop,
2021 authoritylink => $subfield9,
2022 unimarc3 => $unimarc3
2025 return \@marcauthors;
2030 $marcurls = GetMarcUrls($record,$marcflavour);
2032 Returns arrayref of URLs from MARC data, suitable to pass to tmpl loop.
2033 Assumes web resources (not uncommon in MARC21 to omit resource type ind)
2038 my ( $record, $marcflavour ) = @_;
2040 carp 'GetMarcUrls called on undefined record';
2045 for my $field ( $record->field('856') ) {
2047 for my $note ( $field->subfield('z') ) {
2048 push @notes, { note => $note };
2050 my @urls = $field->subfield('u');
2051 foreach my $url (@urls) {
2053 if ( $marcflavour eq 'MARC21' ) {
2054 my $s3 = $field->subfield('3');
2055 my $link = $field->subfield('y');
2056 unless ( $url =~ /^\w+:/ ) {
2057 if ( $field->indicator(1) eq '7' ) {
2058 $url = $field->subfield('2') . "://" . $url;
2059 } elsif ( $field->indicator(1) eq '1' ) {
2060 $url = 'ftp://' . $url;
2063 # properly, this should be if ind1=4,
2064 # however we will assume http protocol since we're building a link.
2065 $url = 'http://' . $url;
2069 # TODO handle ind 2 (relationship)
2074 $marcurl->{'linktext'} = $link || $s3 || C4::Context->preference('URLLinkText') || $url;
2075 $marcurl->{'part'} = $s3 if ($link);
2076 $marcurl->{'toc'} = 1 if ( defined($s3) && $s3 =~ /^[Tt]able/ );
2078 $marcurl->{'linktext'} = $field->subfield('2') || C4::Context->preference('URLLinkText') || $url;
2079 $marcurl->{'MARCURL'} = $url;
2081 push @marcurls, $marcurl;
2087 =head2 GetMarcSeries
2089 $marcseriesarray = GetMarcSeries($record,$marcflavour);
2091 Get all series from the MARC record and returns them in an array.
2092 The series are stored in different fields depending on MARC flavour
2097 my ( $record, $marcflavour ) = @_;
2099 carp 'GetMarcSeries called on undefined record';
2103 my ( $mintag, $maxtag, $fields_filter );
2104 if ( $marcflavour eq "UNIMARC" ) {
2107 $fields_filter = '2..';
2108 } else { # marc21/normarc
2111 $fields_filter = '4..';
2115 my $AuthoritySeparator = C4::Context->preference('AuthoritySeparator');
2117 foreach my $field ( $record->field($fields_filter) ) {
2118 next unless $field->tag() >= $mintag && $field->tag() <= $maxtag;
2120 my @subfields = $field->subfields();
2123 for my $series_subfield (@subfields) {
2125 # ignore $9, used for authority link
2126 next if ( $series_subfield->[0] eq '9' );
2129 my $code = $series_subfield->[0];
2130 my $value = $series_subfield->[1];
2131 my $linkvalue = $value;
2132 $linkvalue =~ s/(\(|\))//g;
2134 # see if this is an instance of a volume
2135 if ( $code eq 'v' ) {
2140 'link' => $linkvalue,
2141 operator => (scalar @link_loop) ? ' and ' : undef
2144 if ($volume_number) {
2145 push @subfields_loop, { volumenum => $value };
2147 push @subfields_loop, {
2150 link_loop => \@link_loop,
2151 separator => (scalar @subfields_loop) ? $AuthoritySeparator : '',
2152 volumenum => $volume_number,
2156 push @marcseries, { MARCSERIES_SUBFIELDS_LOOP => \@subfields_loop };
2159 return \@marcseries;
2160 } #end getMARCseriess
2164 $marchostsarray = GetMarcHosts($record,$marcflavour);
2166 Get all host records (773s MARC21, 461 UNIMARC) from the MARC record and returns them in an array.
2171 my ( $record, $marcflavour ) = @_;
2173 carp 'GetMarcHosts called on undefined record';
2177 my ( $tag,$title_subf,$bibnumber_subf,$itemnumber_subf);
2178 $marcflavour ||="MARC21";
2179 if ( $marcflavour eq "MARC21" || $marcflavour eq "NORMARC" ) {
2182 $bibnumber_subf ="0";
2183 $itemnumber_subf='9';
2185 elsif ($marcflavour eq "UNIMARC") {
2188 $bibnumber_subf ="0";
2189 $itemnumber_subf='9';
2194 foreach my $field ( $record->field($tag)) {
2198 my $hostbiblionumber = $field->subfield("$bibnumber_subf");
2199 my $hosttitle = $field->subfield($title_subf);
2200 my $hostitemnumber=$field->subfield($itemnumber_subf);
2201 push @fields_loop, { hostbiblionumber => $hostbiblionumber, hosttitle => $hosttitle, hostitemnumber => $hostitemnumber};
2202 push @marchosts, { MARCHOSTS_FIELDS_LOOP => \@fields_loop };
2205 my $marchostsarray = \@marchosts;
2206 return $marchostsarray;
2209 =head2 UpsertMarcSubfield
2211 my $record = C4::Biblio::UpsertMarcSubfield($MARC::Record, $fieldTag, $subfieldCode, $subfieldContent);
2215 sub UpsertMarcSubfield {
2216 my ($record, $tag, $code, $content) = @_;
2217 my $f = $record->field($tag);
2220 $f->update( $code => $content );
2223 my $f = MARC::Field->new( $tag, '', '', $code => $content);
2224 $record->insert_fields_ordered( $f );
2228 =head2 UpsertMarcControlField
2230 my $record = C4::Biblio::UpsertMarcControlField($MARC::Record, $fieldTag, $content);
2234 sub UpsertMarcControlField {
2235 my ($record, $tag, $content) = @_;
2236 die "UpsertMarcControlField() \$tag '$tag' is not a control field\n" unless 0+$tag < 10;
2237 my $f = $record->field($tag);
2240 $f->update( $content );
2243 my $f = MARC::Field->new($tag, $content);
2244 $record->insert_fields_ordered( $f );
2248 =head2 GetFrameworkCode
2250 $frameworkcode = GetFrameworkCode( $biblionumber )
2254 sub GetFrameworkCode {
2255 my ($biblionumber) = @_;
2256 my $dbh = C4::Context->dbh;
2257 my $sth = $dbh->prepare("SELECT frameworkcode FROM biblio WHERE biblionumber=?");
2258 $sth->execute($biblionumber);
2259 my ($frameworkcode) = $sth->fetchrow;
2260 return $frameworkcode;
2263 =head2 TransformKohaToMarc
2265 $record = TransformKohaToMarc( $hash )
2267 This function builds partial MARC::Record from a hash
2268 Hash entries can be from biblio or biblioitems.
2270 This function is called in acquisition module, to create a basic catalogue
2271 entry from user entry
2276 sub TransformKohaToMarc {
2278 my $record = MARC::Record->new();
2279 SetMarcUnicodeFlag( $record, C4::Context->preference("marcflavour") );
2280 # FIXME Do not we want to get the marc subfield structure for the biblio framework?
2281 my $mss = GetMarcSubfieldStructure();
2283 while ( my ($kohafield, $value) = each %$hash ) {
2284 next unless exists $mss->{$kohafield};
2285 next unless $mss->{$kohafield};
2286 my $tagfield = $mss->{$kohafield}{tagfield} . '';
2287 my $tagsubfield = $mss->{$kohafield}{tagsubfield};
2288 foreach my $value ( split(/\s?\|\s?/, $value, -1) ) {
2289 next if $value eq '';
2290 $tag_hr->{$tagfield} //= [];
2291 push @{$tag_hr->{$tagfield}}, [($tagsubfield, $value)];
2294 foreach my $tag (sort keys %$tag_hr) {
2295 my @sfl = @{$tag_hr->{$tag}};
2296 @sfl = sort { $a->[0] cmp $b->[0]; } @sfl;
2297 @sfl = map { @{$_}; } @sfl;
2298 $record->insert_fields_ordered(
2299 MARC::Field->new($tag, " ", " ", @sfl)
2305 =head2 PrepHostMarcField
2307 $hostfield = PrepHostMarcField ( $hostbiblionumber,$hostitemnumber,$marcflavour )
2309 This function returns a host field populated with data from the host record, the field can then be added to an analytical record
2313 sub PrepHostMarcField {
2314 my ($hostbiblionumber,$hostitemnumber, $marcflavour) = @_;
2315 $marcflavour ||="MARC21";
2318 my $hostrecord = GetMarcBiblio($hostbiblionumber);
2319 my $item = C4::Items::GetItem($hostitemnumber);
2322 if ( $marcflavour eq "MARC21" || $marcflavour eq "NORMARC" ) {
2326 if ($hostrecord->subfield('100','a')){
2327 $mainentry = $hostrecord->subfield('100','a');
2328 } elsif ($hostrecord->subfield('110','a')){
2329 $mainentry = $hostrecord->subfield('110','a');
2331 $mainentry = $hostrecord->subfield('111','a');
2334 # qualification info
2336 if (my $field260 = $hostrecord->field('260')){
2337 $qualinfo = $field260->as_string( 'abc' );
2342 my $ed = $hostrecord->subfield('250','a');
2343 my $barcode = $item->{'barcode'};
2344 my $title = $hostrecord->subfield('245','a');
2346 # record control number, 001 with 003 and prefix
2348 if ($hostrecord->field('001')){
2349 $recctrlno = $hostrecord->field('001')->data();
2350 if ($hostrecord->field('003')){
2351 $recctrlno = '('.$hostrecord->field('003')->data().')'.$recctrlno;
2356 my $issn = $hostrecord->subfield('022','a');
2357 my $isbn = $hostrecord->subfield('020','a');
2360 $hostmarcfield = MARC::Field->new(
2362 '0' => $hostbiblionumber,
2363 '9' => $hostitemnumber,
2373 } elsif ($marcflavour eq "UNIMARC") {
2374 $hostmarcfield = MARC::Field->new(
2376 '0' => $hostbiblionumber,
2377 't' => $hostrecord->subfield('200','a'),
2378 '9' => $hostitemnumber
2382 return $hostmarcfield;
2385 =head2 TransformHtmlToXml
2387 $xml = TransformHtmlToXml( $tags, $subfields, $values, $indicator,
2388 $ind_tag, $auth_type )
2390 $auth_type contains :
2394 =item - nothing : rebuild a biblio. In UNIMARC the encoding is in 100$a pos 26/27
2396 =item - UNIMARCAUTH : rebuild an authority. In UNIMARC, the encoding is in 100$a pos 13/14
2398 =item - ITEM : rebuild an item : in UNIMARC, 100$a, it's in the biblio ! (otherwise, we would get 2 100 fields !)
2404 sub TransformHtmlToXml {
2405 my ( $tags, $subfields, $values, $indicator, $ind_tag, $auth_type ) = @_;
2406 # NOTE: The parameter $ind_tag is NOT USED -- BZ 11247
2408 my $xml = MARC::File::XML::header('UTF-8');
2409 $xml .= "<record>\n";
2410 $auth_type = C4::Context->preference('marcflavour') unless $auth_type;
2411 MARC::File::XML->default_record_format($auth_type);
2413 # in UNIMARC, field 100 contains the encoding
2414 # check that there is one, otherwise the
2415 # MARC::Record->new_from_xml will fail (and Koha will die)
2416 my $unimarc_and_100_exist = 0;
2417 $unimarc_and_100_exist = 1 if $auth_type eq 'ITEM'; # if we rebuild an item, no need of a 100 field
2422 for ( my $i = 0 ; $i < @$tags ; $i++ ) {
2424 if ( C4::Context->preference('marcflavour') eq 'UNIMARC' and @$tags[$i] eq "100" and @$subfields[$i] eq "a" ) {
2426 # if we have a 100 field and it's values are not correct, skip them.
2427 # if we don't have any valid 100 field, we will create a default one at the end
2428 my $enc = substr( @$values[$i], 26, 2 );
2429 if ( $enc eq '01' or $enc eq '50' or $enc eq '03' ) {
2430 $unimarc_and_100_exist = 1;
2435 @$values[$i] =~ s/&/&/g;
2436 @$values[$i] =~ s/</</g;
2437 @$values[$i] =~ s/>/>/g;
2438 @$values[$i] =~ s/"/"/g;
2439 @$values[$i] =~ s/'/'/g;
2441 if ( ( @$tags[$i] ne $prevtag ) ) {
2442 $j++ unless ( @$tags[$i] eq "" );
2443 my $indicator1 = eval { substr( @$indicator[$j], 0, 1 ) };
2444 my $indicator2 = eval { substr( @$indicator[$j], 1, 1 ) };
2445 my $ind1 = _default_ind_to_space($indicator1);
2447 if ( @$indicator[$j] ) {
2448 $ind2 = _default_ind_to_space($indicator2);
2450 warn "Indicator in @$tags[$i] is empty";
2454 $xml .= "</datafield>\n";
2455 if ( ( @$tags[$i] && @$tags[$i] > 10 )
2456 && ( @$values[$i] ne "" ) ) {
2457 $xml .= "<datafield tag=\"@$tags[$i]\" ind1=\"$ind1\" ind2=\"$ind2\">\n";
2458 $xml .= "<subfield code=\"@$subfields[$i]\">@$values[$i]</subfield>\n";
2464 if ( @$values[$i] ne "" ) {
2467 if ( @$tags[$i] eq "000" ) {
2468 $xml .= "<leader>@$values[$i]</leader>\n";
2471 # rest of the fixed fields
2472 } elsif ( @$tags[$i] < 10 ) {
2473 $xml .= "<controlfield tag=\"@$tags[$i]\">@$values[$i]</controlfield>\n";
2476 $xml .= "<datafield tag=\"@$tags[$i]\" ind1=\"$ind1\" ind2=\"$ind2\">\n";
2477 $xml .= "<subfield code=\"@$subfields[$i]\">@$values[$i]</subfield>\n";
2482 } else { # @$tags[$i] eq $prevtag
2483 my $indicator1 = eval { substr( @$indicator[$j], 0, 1 ) };
2484 my $indicator2 = eval { substr( @$indicator[$j], 1, 1 ) };
2485 my $ind1 = _default_ind_to_space($indicator1);
2487 if ( @$indicator[$j] ) {
2488 $ind2 = _default_ind_to_space($indicator2);
2490 warn "Indicator in @$tags[$i] is empty";
2493 if ( @$values[$i] eq "" ) {
2496 $xml .= "<datafield tag=\"@$tags[$i]\" ind1=\"$ind1\" ind2=\"$ind2\">\n";
2499 $xml .= "<subfield code=\"@$subfields[$i]\">@$values[$i]</subfield>\n";
2502 $prevtag = @$tags[$i];
2504 $xml .= "</datafield>\n" if $xml =~ m/<datafield/;
2505 if ( C4::Context->preference('marcflavour') eq 'UNIMARC' and !$unimarc_and_100_exist ) {
2507 # warn "SETTING 100 for $auth_type";
2508 my $string = strftime( "%Y%m%d", localtime(time) );
2510 # set 50 to position 26 is biblios, 13 if authorities
2512 $pos = 13 if $auth_type eq 'UNIMARCAUTH';
2513 $string = sprintf( "%-*s", 35, $string );
2514 substr( $string, $pos, 6, "50" );
2515 $xml .= "<datafield tag=\"100\" ind1=\"\" ind2=\"\">\n";
2516 $xml .= "<subfield code=\"a\">$string</subfield>\n";
2517 $xml .= "</datafield>\n";
2519 $xml .= "</record>\n";
2520 $xml .= MARC::File::XML::footer();
2524 =head2 _default_ind_to_space
2526 Passed what should be an indicator returns a space
2527 if its undefined or zero length
2531 sub _default_ind_to_space {
2533 if ( !defined $s || $s eq q{} ) {
2539 =head2 TransformHtmlToMarc
2541 L<$record> = TransformHtmlToMarc(L<$cgi>)
2542 L<$cgi> is the CGI object which containts the values for subfields
2544 'tag_010_indicator1_531951' ,
2545 'tag_010_indicator2_531951' ,
2546 'tag_010_code_a_531951_145735' ,
2547 'tag_010_subfield_a_531951_145735' ,
2548 'tag_200_indicator1_873510' ,
2549 'tag_200_indicator2_873510' ,
2550 'tag_200_code_a_873510_673465' ,
2551 'tag_200_subfield_a_873510_673465' ,
2552 'tag_200_code_b_873510_704318' ,
2553 'tag_200_subfield_b_873510_704318' ,
2554 'tag_200_code_e_873510_280822' ,
2555 'tag_200_subfield_e_873510_280822' ,
2556 'tag_200_code_f_873510_110730' ,
2557 'tag_200_subfield_f_873510_110730' ,
2559 L<$record> is the MARC::Record object.
2563 sub TransformHtmlToMarc {
2564 my ($cgi, $isbiblio) = @_;
2566 my @params = $cgi->multi_param();
2568 # explicitly turn on the UTF-8 flag for all
2569 # 'tag_' parameters to avoid incorrect character
2570 # conversion later on
2571 my $cgi_params = $cgi->Vars;
2572 foreach my $param_name ( keys %$cgi_params ) {
2573 if ( $param_name =~ /^tag_/ ) {
2574 my $param_value = $cgi_params->{$param_name};
2575 unless ( Encode::is_utf8( $param_value ) ) {
2576 $cgi_params->{$param_name} = Encode::decode('UTF-8', $param_value );
2581 # creating a new record
2582 my $record = MARC::Record->new();
2584 my ($biblionumbertagfield, $biblionumbertagsubfield) = (-1, -1);
2585 ($biblionumbertagfield, $biblionumbertagsubfield) =
2586 &GetMarcFromKohaField( "biblio.biblionumber", '' ) if $isbiblio;
2587 #FIXME This code assumes that the CGI params will be in the same order as the fields in the template; this is no absolute guarantee!
2588 for (my $i = 0; $params[$i]; $i++ ) { # browse all CGI params
2589 my $param = $params[$i];
2592 # if we are on biblionumber, store it in the MARC::Record (it may not be in the edited fields)
2593 if ( $param eq 'biblionumber' ) {
2594 if ( $biblionumbertagfield < 10 ) {
2595 $newfield = MARC::Field->new( $biblionumbertagfield, scalar $cgi->param($param), );
2597 $newfield = MARC::Field->new( $biblionumbertagfield, '', '', "$biblionumbertagsubfield" => scalar $cgi->param($param), );
2599 push @fields, $newfield if ($newfield);
2600 } elsif ( $param =~ /^tag_(\d*)_indicator1_/ ) { # new field start when having 'input name="..._indicator1_..."
2603 my $ind1 = _default_ind_to_space( substr( $cgi->param($param), 0, 1 ) );
2604 my $ind2 = _default_ind_to_space( substr( $cgi->param( $params[ $i + 1 ] ), 0, 1 ) );
2608 if ( $tag < 10 ) { # no code for theses fields
2609 # in MARC editor, 000 contains the leader.
2610 next if $tag == $biblionumbertagfield;
2611 my $fval= $cgi->param($params[$j+1]);
2612 if ( $tag eq '000' ) {
2613 # Force a fake leader even if not provided to avoid crashing
2614 # during decoding MARC record containing UTF-8 characters
2616 length( $fval ) == 24
2621 # between 001 and 009 (included)
2622 } elsif ( $fval ne '' ) {
2623 $newfield = MARC::Field->new( $tag, $fval, );
2626 # > 009, deal with subfields
2628 # browse subfields for this tag (reason for _code_ match)
2629 while(defined $params[$j] && $params[$j] =~ /_code_/) {
2630 last unless defined $params[$j+1];
2632 if $tag == $biblionumbertagfield and
2633 $cgi->param($params[$j]) eq $biblionumbertagsubfield;
2634 #if next param ne subfield, then it was probably empty
2635 #try next param by incrementing j
2636 if($params[$j+1]!~/_subfield_/) {$j++; next; }
2637 my $fkey= $cgi->param($params[$j]);
2638 my $fval= $cgi->param($params[$j+1]);
2639 #check if subfield value not empty and field exists
2640 if($fval ne '' && $newfield) {
2641 $newfield->add_subfields( $fkey => $fval);
2643 elsif($fval ne '') {
2644 $newfield = MARC::Field->new( $tag, $ind1, $ind2, $fkey => $fval );
2648 $i= $j-1; #update i for outer loop accordingly
2650 push @fields, $newfield if ($newfield);
2654 $record->append_fields(@fields);
2658 =head2 TransformMarcToKoha
2660 $result = TransformMarcToKoha( $record, $frameworkcode )
2662 Extract data from a MARC bib record into a hashref representing
2663 Koha biblio, biblioitems, and items fields.
2665 If passed an undefined record will log the error and return an empty
2670 sub TransformMarcToKoha {
2671 my ( $record, $frameworkcode, $limit_table ) = @_;
2674 if (!defined $record) {
2675 carp('TransformMarcToKoha called with undefined record');
2678 $limit_table = $limit_table || 0;
2679 $frameworkcode = '' unless defined $frameworkcode;
2681 my $inverted_field_map = _get_inverted_marc_field_map($frameworkcode);
2684 if ( defined $limit_table && $limit_table eq 'items' ) {
2685 $tables{'items'} = 1;
2687 $tables{'items'} = 1;
2688 $tables{'biblio'} = 1;
2689 $tables{'biblioitems'} = 1;
2692 # traverse through record
2693 MARCFIELD: foreach my $field ( $record->fields() ) {
2694 my $tag = $field->tag();
2695 next MARCFIELD unless exists $inverted_field_map->{$tag};
2696 if ( $field->is_control_field() ) {
2697 my $kohafields = $inverted_field_map->{$tag}->{list};
2698 ENTRY: foreach my $entry ( @{$kohafields} ) {
2699 my ( $subfield, $table, $column ) = @{$entry};
2700 next ENTRY unless exists $tables{$table};
2701 my $key = _disambiguate( $table, $column );
2702 if ( $result->{$key} ) {
2703 unless ( ( $key eq "biblionumber" or $key eq "biblioitemnumber" ) and ( $field->data() eq "" ) ) {
2704 $result->{$key} .= " | " . $field->data();
2707 $result->{$key} = $field->data();
2712 # deal with subfields
2713 MARCSUBFIELD: foreach my $sf ( $field->subfields() ) {
2714 my $code = $sf->[0];
2715 next MARCSUBFIELD unless exists $inverted_field_map->{$tag}->{sfs}->{$code};
2716 my $value = $sf->[1];
2717 SFENTRY: foreach my $entry ( @{ $inverted_field_map->{$tag}->{sfs}->{$code} } ) {
2718 my ( $table, $column ) = @{$entry};
2719 next SFENTRY unless exists $tables{$table};
2720 my $key = _disambiguate( $table, $column );
2721 if ( $result->{$key} ) {
2722 unless ( ( $key eq "biblionumber" or $key eq "biblioitemnumber" ) and ( $value eq "" ) ) {
2723 $result->{$key} .= " | " . $value;
2726 $result->{$key} = $value;
2733 # modify copyrightdate to keep only the 1st year found
2734 if ( exists $result->{'copyrightdate'} ) {
2735 my $temp = $result->{'copyrightdate'};
2736 $temp =~ m/c(\d\d\d\d)/;
2737 if ( $temp =~ m/c(\d\d\d\d)/ and $1 > 0 ) { # search cYYYY first
2738 $result->{'copyrightdate'} = $1;
2739 } else { # if no cYYYY, get the 1st date.
2740 $temp =~ m/(\d\d\d\d)/;
2741 $result->{'copyrightdate'} = $1;
2745 # modify publicationyear to keep only the 1st year found
2746 if ( exists $result->{'publicationyear'} ) {
2747 my $temp = $result->{'publicationyear'};
2748 if ( $temp =~ m/c(\d\d\d\d)/ and $1 > 0 ) { # search cYYYY first
2749 $result->{'publicationyear'} = $1;
2750 } else { # if no cYYYY, get the 1st date.
2751 $temp =~ m/(\d\d\d\d)/;
2752 $result->{'publicationyear'} = $1;
2759 sub _get_inverted_marc_field_map {
2760 my ( $frameworkcode ) = @_;
2762 my $mss = GetMarcSubfieldStructure( $frameworkcode );
2764 foreach my $kohafield ( keys %{ $mss } ) {
2765 next unless exists $mss->{$kohafield}; # not all columns are mapped to MARC tag & subfield
2766 my $tag = $mss->{$kohafield}{tagfield};
2767 my $subfield = $mss->{$kohafield}{tagsubfield};
2768 my ( $table, $column ) = split /[.]/, $kohafield, 2;
2769 push @{ $field_map->{$tag}->{list} }, [ $subfield, $table, $column ];
2770 push @{ $field_map->{$tag}->{sfs}->{$subfield} }, [ $table, $column ];
2775 =head2 _disambiguate
2777 $newkey = _disambiguate($table, $field);
2779 This is a temporary hack to distinguish between the
2780 following sets of columns when using TransformMarcToKoha.
2782 items.cn_source & biblioitems.cn_source
2783 items.cn_sort & biblioitems.cn_sort
2785 Columns that are currently NOT distinguished (FIXME
2786 due to lack of time to fully test) are:
2788 biblio.notes and biblioitems.notes
2793 FIXME - this is necessary because prefixing each column
2794 name with the table name would require changing lots
2795 of code and templates, and exposing more of the DB
2796 structure than is good to the UI templates, particularly
2797 since biblio and bibloitems may well merge in a future
2798 version. In the future, it would also be good to
2799 separate DB access and UI presentation field names
2804 sub CountItemsIssued {
2805 my ($biblionumber) = @_;
2806 my $dbh = C4::Context->dbh;
2807 my $sth = $dbh->prepare('SELECT COUNT(*) as issuedCount FROM items, issues WHERE items.itemnumber = issues.itemnumber AND items.biblionumber = ?');
2808 $sth->execute($biblionumber);
2809 my $row = $sth->fetchrow_hashref();
2810 return $row->{'issuedCount'};
2814 my ( $table, $column ) = @_;
2815 if ( $column eq "cn_sort" or $column eq "cn_source" ) {
2816 return $table . '.' . $column;
2823 =head2 get_koha_field_from_marc
2825 $result->{_disambiguate($table, $field)} =
2826 get_koha_field_from_marc($table,$field,$record,$frameworkcode);
2828 Internal function to map data from the MARC record to a specific non-MARC field.
2829 FIXME: this is meant to replace TransformMarcToKohaOneField after more testing.
2833 sub get_koha_field_from_marc {
2834 my ( $koha_table, $koha_column, $record, $frameworkcode ) = @_;
2835 my ( $tagfield, $subfield ) = GetMarcFromKohaField( $koha_table . '.' . $koha_column, $frameworkcode );
2837 foreach my $field ( $record->field($tagfield) ) {
2838 if ( $field->tag() < 10 ) {
2840 $kohafield .= " | " . $field->data();
2842 $kohafield = $field->data();
2845 if ( $field->subfields ) {
2846 my @subfields = $field->subfields();
2847 foreach my $subfieldcount ( 0 .. $#subfields ) {
2848 if ( $subfields[$subfieldcount][0] eq $subfield ) {
2850 $kohafield .= " | " . $subfields[$subfieldcount][1];
2852 $kohafield = $subfields[$subfieldcount][1];
2862 =head2 TransformMarcToKohaOneField
2864 $result = TransformMarcToKohaOneField( $kohatable, $kohafield, $record, $result, $frameworkcode )
2868 sub TransformMarcToKohaOneField {
2870 # FIXME ? if a field has a repeatable subfield that is used in old-db,
2871 # only the 1st will be retrieved...
2872 my ( $kohatable, $kohafield, $record, $result, $frameworkcode ) = @_;
2874 my ( $tagfield, $subfield ) = GetMarcFromKohaField( $kohatable . "." . $kohafield, $frameworkcode );
2875 foreach my $field ( $record->field($tagfield) ) {
2876 if ( $field->tag() < 10 ) {
2877 if ( $result->{$kohafield} ) {
2878 $result->{$kohafield} .= " | " . $field->data();
2880 $result->{$kohafield} = $field->data();
2883 if ( $field->subfields ) {
2884 my @subfields = $field->subfields();
2885 foreach my $subfieldcount ( 0 .. $#subfields ) {
2886 if ( $subfields[$subfieldcount][0] eq $subfield ) {
2887 if ( $result->{$kohafield} ) {
2888 $result->{$kohafield} .= " | " . $subfields[$subfieldcount][1];
2890 $result->{$kohafield} = $subfields[$subfieldcount][1];
2904 # true ModZebra commented until indexdata fixes zebraDB crashes (it seems they occur on multiple updates
2906 # replaced by a zebraqueue table, that is filled with ModZebra to run.
2907 # the table is emptied by misc/cronjobs/zebraqueue_start.pl script
2908 # =head2 ModZebrafiles
2910 # &ModZebrafiles( $dbh, $biblionumber, $record, $folder, $server );
2914 # sub ModZebrafiles {
2916 # my ( $dbh, $biblionumber, $record, $folder, $server ) = @_;
2920 # C4::Context->zebraconfig($server)->{directory} . "/" . $folder . "/";
2921 # unless ( opendir( DIR, "$zebradir" ) ) {
2922 # warn "$zebradir not found";
2926 # my $filename = $zebradir . $biblionumber;
2929 # open( OUTPUT, ">", $filename . ".xml" );
2930 # print OUTPUT $record;
2937 ModZebra( $biblionumber, $op, $server, $record );
2939 $biblionumber is the biblionumber we want to index
2941 $op is specialUpdate or recordDelete, and is used to know what we want to do
2943 $server is the server that we want to update
2945 $record is the update MARC record if it's available. If it's not supplied
2946 and is needed, it'll be loaded from the database.
2951 ###Accepts a $server variable thus we can use it for biblios authorities or other zebra dbs
2952 my ( $biblionumber, $op, $server, $record ) = @_;
2953 $debug && warn "ModZebra: update requested for: $biblionumber $op $server\n";
2954 if ( C4::Context->preference('SearchEngine') eq 'Elasticsearch' ) {
2956 # TODO abstract to a standard API that'll work for whatever
2957 require Koha::SearchEngine::Elasticsearch::Indexer;
2958 my $indexer = Koha::SearchEngine::Elasticsearch::Indexer->new(
2960 index => $server eq 'biblioserver'
2961 ? $Koha::SearchEngine::BIBLIOS_INDEX
2962 : $Koha::SearchEngine::AUTHORITIES_INDEX
2965 if ( $op eq 'specialUpdate' ) {
2967 $record = GetMarcBiblio($biblionumber, 1);
2969 my $records = [$record];
2970 $indexer->update_index_background( [$biblionumber], [$record] );
2972 elsif ( $op eq 'recordDelete' ) {
2973 $indexer->delete_index_background( [$biblionumber] );
2976 croak "ModZebra called with unknown operation: $op";
2980 my $dbh = C4::Context->dbh;
2982 # true ModZebra commented until indexdata fixes zebraDB crashes (it seems they occur on multiple updates
2984 # replaced by a zebraqueue table, that is filled with ModZebra to run.
2985 # the table is emptied by rebuild_zebra.pl script (using the -z switch)
2986 my $check_sql = "SELECT COUNT(*) FROM zebraqueue
2988 AND biblio_auth_number = ?
2991 my $check_sth = $dbh->prepare_cached($check_sql);
2992 $check_sth->execute( $server, $biblionumber, $op );
2993 my ($count) = $check_sth->fetchrow_array;
2994 $check_sth->finish();
2995 if ( $count == 0 ) {
2996 my $sth = $dbh->prepare("INSERT INTO zebraqueue (biblio_auth_number,server,operation) VALUES(?,?,?)");
2997 $sth->execute( $biblionumber, $server, $op );
3003 =head2 EmbedItemsInMarcBiblio
3005 EmbedItemsInMarcBiblio($marc, $biblionumber, $itemnumbers, $opac);
3007 Given a MARC::Record object containing a bib record,
3008 modify it to include the items attached to it as 9XX
3009 per the bib's MARC framework.
3010 if $itemnumbers is defined, only specified itemnumbers are embedded.
3012 If $opac is true, then opac-relevant suppressions are included.
3016 sub EmbedItemsInMarcBiblio {
3017 my ($marc, $biblionumber, $itemnumbers, $opac) = @_;
3019 carp 'EmbedItemsInMarcBiblio: No MARC record passed';
3023 $itemnumbers = [] unless defined $itemnumbers;
3025 my $frameworkcode = GetFrameworkCode($biblionumber);
3026 _strip_item_fields($marc, $frameworkcode);
3028 # ... and embed the current items
3029 my $dbh = C4::Context->dbh;
3030 my $sth = $dbh->prepare("SELECT itemnumber FROM items WHERE biblionumber = ?");
3031 $sth->execute($biblionumber);
3033 my ( $itemtag, $itemsubfield ) = GetMarcFromKohaField( "items.itemnumber", $frameworkcode );
3035 my $opachiddenitems = $opac
3036 && ( C4::Context->preference('OpacHiddenItems') !~ /^\s*$/ );
3038 while ( my ($itemnumber) = $sth->fetchrow_array ) {
3039 next if @$itemnumbers and not grep { $_ == $itemnumber } @$itemnumbers;
3040 my $i = $opachiddenitems ? C4::Items::GetItem($itemnumber) : undef;
3041 push @items, { itemnumber => $itemnumber, item => $i };
3045 ? C4::Items::GetHiddenItemnumbers( map { $_->{item} } @items )
3047 # Convert to a hash for quick searching
3048 my %hiddenitems = map { $_ => 1 } @hiddenitems;
3049 foreach my $itemnumber ( map { $_->{itemnumber} } @items ) {
3050 next if $hiddenitems{$itemnumber};
3051 my $item_marc = C4::Items::GetMarcItem( $biblionumber, $itemnumber );
3052 push @item_fields, $item_marc->field($itemtag);
3054 $marc->append_fields(@item_fields);
3057 =head1 INTERNAL FUNCTIONS
3059 =head2 _koha_marc_update_bib_ids
3062 _koha_marc_update_bib_ids($record, $frameworkcode, $biblionumber, $biblioitemnumber);
3064 Internal function to add or update biblionumber and biblioitemnumber to
3069 sub _koha_marc_update_bib_ids {
3070 my ( $record, $frameworkcode, $biblionumber, $biblioitemnumber ) = @_;
3072 my ( $biblio_tag, $biblio_subfield ) = GetMarcFromKohaField( "biblio.biblionumber", $frameworkcode );
3073 die qq{No biblionumber tag for framework "$frameworkcode"} unless $biblio_tag;
3074 my ( $biblioitem_tag, $biblioitem_subfield ) = GetMarcFromKohaField( "biblioitems.biblioitemnumber", $frameworkcode );
3075 die qq{No biblioitemnumber tag for framework "$frameworkcode"} unless $biblioitem_tag;
3077 if ( $biblio_tag < 10 ) {
3078 C4::Biblio::UpsertMarcControlField( $record, $biblio_tag, $biblionumber );
3080 C4::Biblio::UpsertMarcSubfield($record, $biblio_tag, $biblio_subfield, $biblionumber);
3082 if ( $biblioitem_tag < 10 ) {
3083 C4::Biblio::UpsertMarcControlField( $record, $biblioitem_tag, $biblioitemnumber );
3085 C4::Biblio::UpsertMarcSubfield($record, $biblioitem_tag, $biblioitem_subfield, $biblioitemnumber);
3089 =head2 _koha_marc_update_biblioitem_cn_sort
3091 _koha_marc_update_biblioitem_cn_sort($marc, $biblioitem, $frameworkcode);
3093 Given a MARC bib record and the biblioitem hash, update the
3094 subfield that contains a copy of the value of biblioitems.cn_sort.
3098 sub _koha_marc_update_biblioitem_cn_sort {
3100 my $biblioitem = shift;
3101 my $frameworkcode = shift;
3103 my ( $biblioitem_tag, $biblioitem_subfield ) = GetMarcFromKohaField( "biblioitems.cn_sort", $frameworkcode );
3104 return unless $biblioitem_tag;
3106 my ($cn_sort) = GetClassSort( $biblioitem->{'biblioitems.cn_source'}, $biblioitem->{'cn_class'}, $biblioitem->{'cn_item'} );
3108 if ( my $field = $marc->field($biblioitem_tag) ) {
3109 $field->delete_subfield( code => $biblioitem_subfield );
3110 if ( $cn_sort ne '' ) {
3111 $field->add_subfields( $biblioitem_subfield => $cn_sort );
3115 # if we get here, no biblioitem tag is present in the MARC record, so
3116 # we'll create it if $cn_sort is not empty -- this would be
3117 # an odd combination of events, however
3119 $marc->insert_grouped_field( MARC::Field->new( $biblioitem_tag, ' ', ' ', $biblioitem_subfield => $cn_sort ) );
3124 =head2 _koha_add_biblio
3126 my ($biblionumber,$error) = _koha_add_biblio($dbh,$biblioitem);
3128 Internal function to add a biblio ($biblio is a hash with the values)
3132 sub _koha_add_biblio {
3133 my ( $dbh, $biblio, $frameworkcode ) = @_;
3137 # set the series flag
3138 unless (defined $biblio->{'serial'}){
3139 $biblio->{'serial'} = 0;
3140 if ( $biblio->{'seriestitle'} ) { $biblio->{'serial'} = 1 }
3143 my $query = "INSERT INTO biblio
3144 SET frameworkcode = ?,
3155 my $sth = $dbh->prepare($query);
3157 $frameworkcode, $biblio->{'author'}, $biblio->{'title'}, $biblio->{'unititle'}, $biblio->{'notes'},
3158 $biblio->{'serial'}, $biblio->{'seriestitle'}, $biblio->{'copyrightdate'}, $biblio->{'abstract'}
3161 my $biblionumber = $dbh->{'mysql_insertid'};
3162 if ( $dbh->errstr ) {
3163 $error .= "ERROR in _koha_add_biblio $query" . $dbh->errstr;
3169 #warn "LEAVING _koha_add_biblio: ".$biblionumber."\n";
3170 return ( $biblionumber, $error );
3173 =head2 _koha_modify_biblio
3175 my ($biblionumber,$error) == _koha_modify_biblio($dbh,$biblio,$frameworkcode);
3177 Internal function for updating the biblio table
3181 sub _koha_modify_biblio {
3182 my ( $dbh, $biblio, $frameworkcode ) = @_;
3187 SET frameworkcode = ?,
3196 WHERE biblionumber = ?
3199 my $sth = $dbh->prepare($query);
3202 $frameworkcode, $biblio->{'author'}, $biblio->{'title'}, $biblio->{'unititle'}, $biblio->{'notes'},
3203 $biblio->{'serial'}, $biblio->{'seriestitle'}, $biblio->{'copyrightdate'}, $biblio->{'abstract'}, $biblio->{'biblionumber'}
3204 ) if $biblio->{'biblionumber'};
3206 if ( $dbh->errstr || !$biblio->{'biblionumber'} ) {
3207 $error .= "ERROR in _koha_modify_biblio $query" . $dbh->errstr;
3210 return ( $biblio->{'biblionumber'}, $error );
3213 =head2 _koha_modify_biblioitem_nonmarc
3215 my ($biblioitemnumber,$error) = _koha_modify_biblioitem_nonmarc( $dbh, $biblioitem );
3219 sub _koha_modify_biblioitem_nonmarc {
3220 my ( $dbh, $biblioitem ) = @_;
3223 # re-calculate the cn_sort, it may have changed
3224 my ($cn_sort) = GetClassSort( $biblioitem->{'biblioitems.cn_source'}, $biblioitem->{'cn_class'}, $biblioitem->{'cn_item'} );
3226 my $query = "UPDATE biblioitems
3227 SET biblionumber = ?,
3233 publicationyear = ?,
3237 collectiontitle = ?,
3239 collectionvolume= ?,
3240 editionstatement= ?,
3241 editionresponsibility = ?,
3257 where biblioitemnumber = ?
3259 my $sth = $dbh->prepare($query);
3261 $biblioitem->{'biblionumber'}, $biblioitem->{'volume'}, $biblioitem->{'number'}, $biblioitem->{'itemtype'},
3262 $biblioitem->{'isbn'}, $biblioitem->{'issn'}, $biblioitem->{'publicationyear'}, $biblioitem->{'publishercode'},
3263 $biblioitem->{'volumedate'}, $biblioitem->{'volumedesc'}, $biblioitem->{'collectiontitle'}, $biblioitem->{'collectionissn'},
3264 $biblioitem->{'collectionvolume'}, $biblioitem->{'editionstatement'}, $biblioitem->{'editionresponsibility'}, $biblioitem->{'illus'},
3265 $biblioitem->{'pages'}, $biblioitem->{'bnotes'}, $biblioitem->{'size'}, $biblioitem->{'place'},
3266 $biblioitem->{'lccn'}, $biblioitem->{'url'}, $biblioitem->{'biblioitems.cn_source'}, $biblioitem->{'cn_class'},
3267 $biblioitem->{'cn_item'}, $biblioitem->{'cn_suffix'}, $cn_sort, $biblioitem->{'totalissues'},
3268 $biblioitem->{'ean'}, $biblioitem->{'agerestriction'}, $biblioitem->{'biblioitemnumber'}
3270 if ( $dbh->errstr ) {
3271 $error .= "ERROR in _koha_modify_biblioitem_nonmarc $query" . $dbh->errstr;
3274 return ( $biblioitem->{'biblioitemnumber'}, $error );
3277 =head2 _koha_add_biblioitem
3279 my ($biblioitemnumber,$error) = _koha_add_biblioitem( $dbh, $biblioitem );
3281 Internal function to add a biblioitem
3285 sub _koha_add_biblioitem {
3286 my ( $dbh, $biblioitem ) = @_;
3289 my ($cn_sort) = GetClassSort( $biblioitem->{'biblioitems.cn_source'}, $biblioitem->{'cn_class'}, $biblioitem->{'cn_item'} );
3290 my $query = "INSERT INTO biblioitems SET
3297 publicationyear = ?,
3301 collectiontitle = ?,
3303 collectionvolume= ?,
3304 editionstatement= ?,
3305 editionresponsibility = ?,
3322 my $sth = $dbh->prepare($query);
3324 $biblioitem->{'biblionumber'}, $biblioitem->{'volume'}, $biblioitem->{'number'}, $biblioitem->{'itemtype'},
3325 $biblioitem->{'isbn'}, $biblioitem->{'issn'}, $biblioitem->{'publicationyear'}, $biblioitem->{'publishercode'},
3326 $biblioitem->{'volumedate'}, $biblioitem->{'volumedesc'}, $biblioitem->{'collectiontitle'}, $biblioitem->{'collectionissn'},
3327 $biblioitem->{'collectionvolume'}, $biblioitem->{'editionstatement'}, $biblioitem->{'editionresponsibility'}, $biblioitem->{'illus'},
3328 $biblioitem->{'pages'}, $biblioitem->{'bnotes'}, $biblioitem->{'size'}, $biblioitem->{'place'},
3329 $biblioitem->{'lccn'}, $biblioitem->{'url'}, $biblioitem->{'biblioitems.cn_source'},
3330 $biblioitem->{'cn_class'}, $biblioitem->{'cn_item'}, $biblioitem->{'cn_suffix'}, $cn_sort,
3331 $biblioitem->{'totalissues'}, $biblioitem->{'ean'}, $biblioitem->{'agerestriction'}
3333 my $bibitemnum = $dbh->{'mysql_insertid'};
3335 if ( $dbh->errstr ) {
3336 $error .= "ERROR in _koha_add_biblioitem $query" . $dbh->errstr;
3340 return ( $bibitemnum, $error );
3343 =head2 _koha_delete_biblio
3345 $error = _koha_delete_biblio($dbh,$biblionumber);
3347 Internal sub for deleting from biblio table -- also saves to deletedbiblio
3349 C<$dbh> - the database handle
3351 C<$biblionumber> - the biblionumber of the biblio to be deleted
3355 # FIXME: add error handling
3357 sub _koha_delete_biblio {
3358 my ( $dbh, $biblionumber ) = @_;
3360 # get all the data for this biblio
3361 my $sth = $dbh->prepare("SELECT * FROM biblio WHERE biblionumber=?");
3362 $sth->execute($biblionumber);
3364 # FIXME There is a transaction in _koha_delete_biblio_metadata
3365 # But actually all the following should be done inside a single transaction
3366 if ( my $data = $sth->fetchrow_hashref ) {
3368 # save the record in deletedbiblio
3369 # find the fields to save
3370 my $query = "INSERT INTO deletedbiblio SET ";
3372 foreach my $temp ( keys %$data ) {
3373 $query .= "$temp = ?,";
3374 push( @bind, $data->{$temp} );
3377 # replace the last , by ",?)"
3379 my $bkup_sth = $dbh->prepare($query);
3380 $bkup_sth->execute(@bind);
3383 _koha_delete_biblio_metadata( $biblionumber );
3386 my $sth2 = $dbh->prepare("DELETE FROM biblio WHERE biblionumber=?");
3387 $sth2->execute($biblionumber);
3388 # update the timestamp (Bugzilla 7146)
3389 $sth2= $dbh->prepare("UPDATE deletedbiblio SET timestamp=NOW() WHERE biblionumber=?");
3390 $sth2->execute($biblionumber);
3397 =head2 _koha_delete_biblioitems
3399 $error = _koha_delete_biblioitems($dbh,$biblioitemnumber);
3401 Internal sub for deleting from biblioitems table -- also saves to deletedbiblioitems
3403 C<$dbh> - the database handle
3404 C<$biblionumber> - the biblioitemnumber of the biblioitem to be deleted
3408 # FIXME: add error handling
3410 sub _koha_delete_biblioitems {
3411 my ( $dbh, $biblioitemnumber ) = @_;
3413 # get all the data for this biblioitem
3414 my $sth = $dbh->prepare("SELECT * FROM biblioitems WHERE biblioitemnumber=?");
3415 $sth->execute($biblioitemnumber);
3417 if ( my $data = $sth->fetchrow_hashref ) {
3419 # save the record in deletedbiblioitems
3420 # find the fields to save
3421 my $query = "INSERT INTO deletedbiblioitems SET ";
3423 foreach my $temp ( keys %$data ) {
3424 $query .= "$temp = ?,";
3425 push( @bind, $data->{$temp} );
3428 # replace the last , by ",?)"
3430 my $bkup_sth = $dbh->prepare($query);
3431 $bkup_sth->execute(@bind);
3434 # delete the biblioitem
3435 my $sth2 = $dbh->prepare("DELETE FROM biblioitems WHERE biblioitemnumber=?");
3436 $sth2->execute($biblioitemnumber);
3437 # update the timestamp (Bugzilla 7146)
3438 $sth2= $dbh->prepare("UPDATE deletedbiblioitems SET timestamp=NOW() WHERE biblioitemnumber=?");
3439 $sth2->execute($biblioitemnumber);
3446 =head2 _koha_delete_biblio_metadata
3448 $error = _koha_delete_biblio_metadata($biblionumber);
3450 C<$biblionumber> - the biblionumber of the biblio metadata to be deleted
3454 sub _koha_delete_biblio_metadata {
3455 my ($biblionumber) = @_;
3457 my $dbh = C4::Context->dbh;
3458 my $schema = Koha::Database->new->schema;
3462 INSERT INTO deletedbiblio_metadata (biblionumber, format, marcflavour, metadata)
3463 SELECT biblionumber, format, marcflavour, metadata FROM biblio_metadata WHERE biblionumber=?
3464 |, undef, $biblionumber );
3465 $dbh->do( q|DELETE FROM biblio_metadata WHERE biblionumber=?|,
3466 undef, $biblionumber );
3471 =head1 UNEXPORTED FUNCTIONS
3473 =head2 ModBiblioMarc
3475 &ModBiblioMarc($newrec,$biblionumber,$frameworkcode);
3477 Add MARC XML data for a biblio to koha
3479 Function exported, but should NOT be used, unless you really know what you're doing
3484 # pass the MARC::Record to this function, and it will create the records in
3486 my ( $record, $biblionumber, $frameworkcode ) = @_;
3488 carp 'ModBiblioMarc passed an undefined record';
3492 # Clone record as it gets modified
3493 $record = $record->clone();
3494 my $dbh = C4::Context->dbh;
3495 my @fields = $record->fields();
3496 if ( !$frameworkcode ) {
3497 $frameworkcode = "";
3499 my $sth = $dbh->prepare("UPDATE biblio SET frameworkcode=? WHERE biblionumber=?");
3500 $sth->execute( $frameworkcode, $biblionumber );
3502 my $encoding = C4::Context->preference("marcflavour");
3504 # deal with UNIMARC field 100 (encoding) : create it if needed & set encoding to unicode
3505 if ( $encoding eq "UNIMARC" ) {
3506 my $defaultlanguage = C4::Context->preference("UNIMARCField100Language");
3507 $defaultlanguage = "fre" if (!$defaultlanguage || length($defaultlanguage) != 3);
3508 my $string = $record->subfield( 100, "a" );
3509 if ( ($string) && ( length( $record->subfield( 100, "a" ) ) == 36 ) ) {
3510 my $f100 = $record->field(100);
3511 $record->delete_field($f100);
3513 $string = POSIX::strftime( "%Y%m%d", localtime );
3515 $string = sprintf( "%-*s", 35, $string );
3516 substr ( $string, 22, 3, $defaultlanguage);
3518 substr( $string, 25, 3, "y50" );
3519 unless ( $record->subfield( 100, "a" ) ) {
3520 $record->insert_fields_ordered( MARC::Field->new( 100, "", "", "a" => $string ) );
3524 #enhancement 5374: update transaction date (005) for marc21/unimarc
3525 if($encoding =~ /MARC21|UNIMARC/) {
3526 my @a= (localtime) [5,4,3,2,1,0]; $a[0]+=1900; $a[1]++;
3527 # YY MM DD HH MM SS (update year and month)
3528 my $f005= $record->field('005');
3529 $f005->update(sprintf("%4d%02d%02d%02d%02d%04.1f",@a)) if $f005;
3533 biblionumber => $biblionumber,
3534 format => 'marcxml',
3535 marcflavour => C4::Context->preference('marcflavour'),
3537 # FIXME To replace with ->find_or_create?
3538 if ( my $m_rs = Koha::Biblio::Metadatas->find($metadata) ) {
3539 $m_rs->metadata( $record->as_xml_record($encoding) );
3542 my $m_rs = Koha::Biblio::Metadata->new($metadata);
3543 $m_rs->metadata( $record->as_xml_record($encoding) );
3546 ModZebra( $biblionumber, "specialUpdate", "biblioserver", $record );
3547 return $biblionumber;
3550 =head2 CountBiblioInOrders
3552 $count = &CountBiblioInOrders( $biblionumber);
3554 This function return count of biblios in orders with $biblionumber
3558 sub CountBiblioInOrders {
3559 my ($biblionumber) = @_;
3560 my $dbh = C4::Context->dbh;
3561 my $query = "SELECT count(*)
3563 WHERE biblionumber=? AND (datecancellationprinted IS NULL OR datecancellationprinted='0000-00-00')";
3564 my $sth = $dbh->prepare($query);
3565 $sth->execute($biblionumber);
3566 my $count = $sth->fetchrow;
3570 =head2 GetSubscriptionsId
3572 $subscriptions = &GetSubscriptionsId($biblionumber);
3574 This function return an array of subscriptionid with $biblionumber
3578 sub GetSubscriptionsId {
3579 my ($biblionumber) = @_;
3580 my $dbh = C4::Context->dbh;
3581 my $query = "SELECT subscriptionid
3583 WHERE biblionumber=?";
3584 my $sth = $dbh->prepare($query);
3585 $sth->execute($biblionumber);
3586 my @subscriptions = $sth->fetchrow_array;
3587 return (@subscriptions);
3590 =head2 prepare_host_field
3592 $marcfield = prepare_host_field( $hostbiblioitem, $marcflavour );
3593 Generate the host item entry for an analytic child entry
3597 sub prepare_host_field {
3598 my ( $hostbiblio, $marcflavour ) = @_;
3599 $marcflavour ||= C4::Context->preference('marcflavour');
3600 my $host = GetMarcBiblio($hostbiblio);
3601 # unfortunately as_string does not 'do the right thing'
3602 # if field returns undef
3606 if ( $marcflavour eq 'MARC21' || $marcflavour eq 'NORMARC' ) {
3607 if ( $field = $host->field('100') || $host->field('110') || $host->field('11') ) {
3608 my $s = $field->as_string('ab');
3613 if ( $field = $host->field('245') ) {
3614 my $s = $field->as_string('a');
3619 if ( $field = $host->field('260') ) {
3620 my $s = $field->as_string('abc');
3625 if ( $field = $host->field('240') ) {
3626 my $s = $field->as_string();
3631 if ( $field = $host->field('022') ) {
3632 my $s = $field->as_string('a');
3637 if ( $field = $host->field('020') ) {
3638 my $s = $field->as_string('a');
3643 if ( $field = $host->field('001') ) {
3644 $sfd{w} = $field->data(),;
3646 $host_field = MARC::Field->new( 773, '0', ' ', %sfd );
3649 elsif ( $marcflavour eq 'UNIMARC' ) {
3651 if ( $field = $host->field('700') || $host->field('710') || $host->field('720') ) {
3652 my $s = $field->as_string('ab');
3658 if ( $field = $host->field('200') ) {
3659 my $s = $field->as_string('a');
3664 #place of publicaton
3665 if ( $field = $host->field('210') ) {
3666 my $s = $field->as_string('a');
3671 #date of publication
3672 if ( $field = $host->field('210') ) {
3673 my $s = $field->as_string('d');
3679 if ( $field = $host->field('205') ) {
3680 my $s = $field->as_string();
3686 if ( $field = $host->field('856') ) {
3687 my $s = $field->as_string('u');
3693 if ( $field = $host->field('011') ) {
3694 my $s = $field->as_string('a');
3700 if ( $field = $host->field('010') ) {
3701 my $s = $field->as_string('a');
3706 if ( $field = $host->field('001') ) {
3707 $sfd{0} = $field->data(),;
3709 $host_field = MARC::Field->new( 461, '0', ' ', %sfd );
3716 =head2 UpdateTotalIssues
3718 UpdateTotalIssues($biblionumber, $increase, [$value])
3720 Update the total issue count for a particular bib record.
3724 =item C<$biblionumber> is the biblionumber of the bib to update
3726 =item C<$increase> is the amount to increase (or decrease) the total issues count by
3728 =item C<$value> is the absolute value that total issues count should be set to. If provided, C<$increase> is ignored.
3734 sub UpdateTotalIssues {
3735 my ($biblionumber, $increase, $value) = @_;
3738 my $record = GetMarcBiblio($biblionumber);
3740 carp "UpdateTotalIssues could not get biblio record";
3743 my $data = GetBiblioData($biblionumber);
3745 carp "UpdateTotalIssues could not get datas of biblio";
3748 my ($totalissuestag, $totalissuessubfield) = GetMarcFromKohaField('biblioitems.totalissues', $data->{'frameworkcode'});
3749 unless ($totalissuestag) {
3750 return 1; # There is nothing to do
3753 if (defined $value) {
3754 $totalissues = $value;
3756 $totalissues = $data->{'totalissues'} + $increase;
3759 my $field = $record->field($totalissuestag);
3760 if (defined $field) {
3761 $field->update( $totalissuessubfield => $totalissues );
3763 $field = MARC::Field->new($totalissuestag, '0', '0',
3764 $totalissuessubfield => $totalissues);
3765 $record->insert_grouped_field($field);
3768 return ModBiblio($record, $biblionumber, $data->{'frameworkcode'});
3773 &RemoveAllNsb($record);
3775 Removes all nsb/nse chars from a record
3782 carp 'RemoveAllNsb called with undefined record';
3786 SetUTF8Flag($record);
3788 foreach my $field ($record->fields()) {
3789 if ($field->is_control_field()) {
3790 $field->update(nsb_clean($field->data()));
3792 my @subfields = $field->subfields();
3794 foreach my $subfield (@subfields) {
3795 push @new_subfields, $subfield->[0] => nsb_clean($subfield->[1]);
3797 if (scalar(@new_subfields) > 0) {
3800 $new_field = MARC::Field->new(
3802 $field->indicator(1),
3803 $field->indicator(2),
3808 warn "error in RemoveAllNsb : $@";
3810 $field->replace_with($new_field);
3826 Koha Development Team <http://koha-community.org/>
3828 Paul POULAIN paul.poulain@free.fr
3830 Joshua Ferraro jmf@liblime.com