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;
48 use Koha::SearchEngine;
51 use vars qw(@ISA @EXPORT);
52 use vars qw($debug $cgi_debug);
57 @ISA = qw( Exporter );
71 GetBiblioItemByBiblioNumber
93 &GetAuthorisedValueDesc
95 &IsMarcStructureInternal
97 &GetMarcSubfieldStructureFromKohaField
106 # To modify something
114 # To delete something
119 # To link headings in a bib record
120 # to authority records.
123 &LinkBibHeadingsToAuthorities
127 # those functions are exported but should not be used
128 # they are useful in a few circumstances, so they are exported,
129 # but don't use them unless you are a core developer ;-)
145 C4::Biblio - cataloging management functions
149 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:
153 =item 1. in the biblio,biblioitems,items, etc tables, which are limited to a one-to-one mapping to underlying MARC data
155 =item 2. as raw MARC in the Zebra index and storage engine
157 =item 3. as MARC XML in biblio_metadata.metadata
161 In the 3.0 version of Koha, the authoritative record-level information is in biblio_metadata.metadata
163 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.
167 =item 1. Compared with MySQL, Zebra is slow to update an index for small data changes -- especially for proc-intensive operations like circulation
169 =item 2. Zebra's index has been known to crash and a backup of the data is necessary to rebuild it in such cases
173 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:
177 =item 1. Add*/Mod*/Del*/ - high-level external functions suitable for being called from external scripts to manage the collection
179 =item 2. _koha_* - low-level internal functions for managing the koha tables
181 =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.
183 =item 4. Zebra functions used to update the Zebra index
185 =item 5. internal helper functions such as char_decode, checkitems, etc. Some of these probably belong in Koha.pm
189 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 :
193 =item 1. save datas in biblio and biblioitems table, that gives us a biblionumber and a biblioitemnumber
195 =item 2. add the biblionumber and biblioitemnumber into the MARC records
197 =item 3. save the marc record
201 =head1 EXPORTED FUNCTIONS
205 ($biblionumber,$biblioitemnumber) = AddBiblio($record,$frameworkcode);
207 Exported function (core API) for adding a new biblio to koha.
209 The first argument is a C<MARC::Record> object containing the
210 bib to add, while the second argument is the desired MARC
213 This function also accepts a third, optional argument: a hashref
214 to additional options. The only defined option is C<defer_marc_save>,
215 which if present and mapped to a true value, causes C<AddBiblio>
216 to omit the call to save the MARC in C<biblio_metadata.metadata>
217 This option is provided B<only>
218 for the use of scripts such as C<bulkmarcimport.pl> that may need
219 to do some manipulation of the MARC record for item parsing before
220 saving it and which cannot afford the performance hit of saving
221 the MARC record twice. Consequently, do not use that option
222 unless you can guarantee that C<ModBiblioMarc> will be called.
228 my $frameworkcode = shift;
229 my $options = @_ ? shift : undef;
230 my $defer_marc_save = 0;
232 carp('AddBiblio called with undefined record');
235 if ( defined $options and exists $options->{'defer_marc_save'} and $options->{'defer_marc_save'} ) {
236 $defer_marc_save = 1;
239 my ( $biblionumber, $biblioitemnumber, $error );
240 my $dbh = C4::Context->dbh;
242 # transform the data into koha-table style data
243 SetUTF8Flag($record);
244 my $olddata = TransformMarcToKoha( $record, $frameworkcode );
245 ( $biblionumber, $error ) = _koha_add_biblio( $dbh, $olddata, $frameworkcode );
246 $olddata->{'biblionumber'} = $biblionumber;
247 ( $biblioitemnumber, $error ) = _koha_add_biblioitem( $dbh, $olddata );
249 _koha_marc_update_bib_ids( $record, $frameworkcode, $biblionumber, $biblioitemnumber );
251 # update MARC subfield that stores biblioitems.cn_sort
252 _koha_marc_update_biblioitem_cn_sort( $record, $olddata, $frameworkcode );
255 ModBiblioMarc( $record, $biblionumber, $frameworkcode ) unless $defer_marc_save;
257 # update OAI-PMH sets
258 if(C4::Context->preference("OAI-PMH:AutoUpdateSets")) {
259 C4::OAI::Sets::UpdateOAISetsBiblio($biblionumber, $record);
262 logaction( "CATALOGUING", "ADD", $biblionumber, "biblio" ) if C4::Context->preference("CataloguingLog");
263 return ( $biblionumber, $biblioitemnumber );
268 ModBiblio( $record,$biblionumber,$frameworkcode);
270 Replace an existing bib record identified by C<$biblionumber>
271 with one supplied by the MARC::Record object C<$record>. The embedded
272 item, biblioitem, and biblionumber fields from the previous
273 version of the bib record replace any such fields of those tags that
274 are present in C<$record>. Consequently, ModBiblio() is not
275 to be used to try to modify item records.
277 C<$frameworkcode> specifies the MARC framework to use
278 when storing the modified bib record; among other things,
279 this controls how MARC fields get mapped to display columns
280 in the C<biblio> and C<biblioitems> tables, as well as
281 which fields are used to store embedded item, biblioitem,
282 and biblionumber data for indexing.
284 Returns 1 on success 0 on failure
289 my ( $record, $biblionumber, $frameworkcode ) = @_;
291 carp 'No record passed to ModBiblio';
295 if ( C4::Context->preference("CataloguingLog") ) {
296 my $newrecord = GetMarcBiblio($biblionumber);
297 logaction( "CATALOGUING", "MODIFY", $biblionumber, "biblio BEFORE=>" . $newrecord->as_formatted );
300 # Cleaning up invalid fields must be done early or SetUTF8Flag is liable to
301 # throw an exception which probably won't be handled.
302 foreach my $field ($record->fields()) {
303 if (! $field->is_control_field()) {
304 if (scalar($field->subfields()) == 0 || (scalar($field->subfields()) == 1 && $field->subfield('9'))) {
305 $record->delete_field($field);
310 SetUTF8Flag($record);
311 my $dbh = C4::Context->dbh;
313 $frameworkcode = "" if !$frameworkcode || $frameworkcode eq "Default"; # XXX
315 _strip_item_fields($record, $frameworkcode);
317 # update biblionumber and biblioitemnumber in MARC
318 # FIXME - this is assuming a 1 to 1 relationship between
319 # biblios and biblioitems
320 my $sth = $dbh->prepare("select biblioitemnumber from biblioitems where biblionumber=?");
321 $sth->execute($biblionumber);
322 my ($biblioitemnumber) = $sth->fetchrow;
324 _koha_marc_update_bib_ids( $record, $frameworkcode, $biblionumber, $biblioitemnumber );
326 # load the koha-table data object
327 my $oldbiblio = TransformMarcToKoha( $record, $frameworkcode );
329 # update MARC subfield that stores biblioitems.cn_sort
330 _koha_marc_update_biblioitem_cn_sort( $record, $oldbiblio, $frameworkcode );
332 # update the MARC record (that now contains biblio and items) with the new record data
333 &ModBiblioMarc( $record, $biblionumber, $frameworkcode );
335 # modify the other koha tables
336 _koha_modify_biblio( $dbh, $oldbiblio, $frameworkcode );
337 _koha_modify_biblioitem_nonmarc( $dbh, $oldbiblio );
339 # update OAI-PMH sets
340 if(C4::Context->preference("OAI-PMH:AutoUpdateSets")) {
341 C4::OAI::Sets::UpdateOAISetsBiblio($biblionumber, $record);
347 =head2 _strip_item_fields
349 _strip_item_fields($record, $frameworkcode)
351 Utility routine to remove item tags from a
356 sub _strip_item_fields {
358 my $frameworkcode = shift;
359 # get the items before and append them to the biblio before updating the record, atm we just have the biblio
360 my ( $itemtag, $itemsubfield ) = GetMarcFromKohaField( "items.itemnumber", $frameworkcode );
362 # delete any item fields from incoming record to avoid
363 # duplication or incorrect data - use AddItem() or ModItem()
365 foreach my $field ( $record->field($itemtag) ) {
366 $record->delete_field($field);
372 my $error = &DelBiblio($biblionumber);
374 Exported function (core API) for deleting a biblio in koha.
375 Deletes biblio record from Zebra and Koha tables (biblio & biblioitems)
376 Also backs it up to deleted* tables.
377 Checks to make sure that the biblio has no items attached.
379 C<$error> : undef unless an error occurs
384 my ($biblionumber) = @_;
385 my $dbh = C4::Context->dbh;
386 my $error; # for error handling
388 # First make sure this biblio has no items attached
389 my $sth = $dbh->prepare("SELECT itemnumber FROM items WHERE biblionumber=?");
390 $sth->execute($biblionumber);
391 if ( my $itemnumber = $sth->fetchrow ) {
393 # Fix this to use a status the template can understand
394 $error .= "This Biblio has items attached, please delete them first before deleting this biblio ";
397 return $error if $error;
399 # We delete attached subscriptions
401 my $subscriptions = C4::Serials::GetFullSubscriptionsFromBiblionumber($biblionumber);
402 foreach my $subscription (@$subscriptions) {
403 C4::Serials::DelSubscription( $subscription->{subscriptionid} );
406 # We delete any existing holds
407 my $biblio = Koha::Biblios->find( $biblionumber );
408 my $holds = $biblio->holds;
409 require C4::Reserves;
410 while ( my $hold = $holds->next ) {
411 C4::Reserves::CancelReserve({ reserve_id => $hold->reserve_id }); # TODO Replace with $hold->cancel
414 # Delete in Zebra. Be careful NOT to move this line after _koha_delete_biblio
415 # for at least 2 reasons :
416 # - if something goes wrong, the biblio may be deleted from Koha but not from zebra
417 # 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)
418 ModZebra( $biblionumber, "recordDelete", "biblioserver" );
420 # delete biblioitems and items from Koha tables and save in deletedbiblioitems,deleteditems
421 $sth = $dbh->prepare("SELECT biblioitemnumber FROM biblioitems WHERE biblionumber=?");
422 $sth->execute($biblionumber);
423 while ( my $biblioitemnumber = $sth->fetchrow ) {
425 # delete this biblioitem
426 $error = _koha_delete_biblioitems( $dbh, $biblioitemnumber );
427 return $error if $error;
431 # delete biblio from Koha tables and save in deletedbiblio
432 # must do this *after* _koha_delete_biblioitems, otherwise
433 # delete cascade will prevent deletedbiblioitems rows
434 # from being generated by _koha_delete_biblioitems
435 $error = _koha_delete_biblio( $dbh, $biblionumber );
437 logaction( "CATALOGUING", "DELETE", $biblionumber, "biblio" ) if C4::Context->preference("CataloguingLog");
443 =head2 BiblioAutoLink
445 my $headings_linked = BiblioAutoLink($record, $frameworkcode)
447 Automatically links headings in a bib record to authorities.
449 Returns the number of headings changed
455 my $frameworkcode = shift;
457 carp('Undefined record passed to BiblioAutoLink');
460 my ( $num_headings_changed, %results );
463 "C4::Linker::" . ( C4::Context->preference("LinkerModule") || 'Default' );
464 unless ( can_load( modules => { $linker_module => undef } ) ) {
465 $linker_module = 'C4::Linker::Default';
466 unless ( can_load( modules => { $linker_module => undef } ) ) {
471 my $linker = $linker_module->new(
472 { 'options' => C4::Context->preference("LinkerOptions") } );
473 my ( $headings_changed, undef ) =
474 LinkBibHeadingsToAuthorities( $linker, $record, $frameworkcode, C4::Context->preference("CatalogModuleRelink") || '' );
475 # By default we probably don't want to relink things when cataloging
476 return $headings_changed;
479 =head2 LinkBibHeadingsToAuthorities
481 my $num_headings_changed, %results = LinkBibHeadingsToAuthorities($linker, $marc, $frameworkcode, [$allowrelink]);
483 Links bib headings to authority records by checking
484 each authority-controlled field in the C<MARC::Record>
485 object C<$marc>, looking for a matching authority record,
486 and setting the linking subfield $9 to the ID of that
489 If $allowrelink is false, existing authids will never be
490 replaced, regardless of the values of LinkerKeepStale and
493 Returns the number of heading links changed in the
498 sub LinkBibHeadingsToAuthorities {
501 my $frameworkcode = shift;
502 my $allowrelink = shift;
505 carp 'LinkBibHeadingsToAuthorities called on undefined bib record';
509 require C4::AuthoritiesMarc;
511 $allowrelink = 1 unless defined $allowrelink;
512 my $num_headings_changed = 0;
513 foreach my $field ( $bib->fields() ) {
514 my $heading = C4::Heading->new_from_bib_field( $field, $frameworkcode );
515 next unless defined $heading;
518 my $current_link = $field->subfield('9');
520 if ( defined $current_link && (!$allowrelink || !C4::Context->preference('LinkerRelink')) )
522 $results{'linked'}->{ $heading->display_form() }++;
526 my ( $authid, $fuzzy ) = $linker->get_link($heading);
528 $results{ $fuzzy ? 'fuzzy' : 'linked' }
529 ->{ $heading->display_form() }++;
530 next if defined $current_link and $current_link == $authid;
532 $field->delete_subfield( code => '9' ) if defined $current_link;
533 $field->add_subfields( '9', $authid );
534 $num_headings_changed++;
537 if ( defined $current_link
538 && (!$allowrelink || C4::Context->preference('LinkerKeepStale')) )
540 $results{'fuzzy'}->{ $heading->display_form() }++;
542 elsif ( C4::Context->preference('AutoCreateAuthorities') ) {
543 if ( _check_valid_auth_link( $current_link, $field ) ) {
544 $results{'linked'}->{ $heading->display_form() }++;
547 my $authority_type = Koha::Authority::Types->find( $heading->auth_type() );
548 my $marcrecordauth = MARC::Record->new();
549 if ( C4::Context->preference('marcflavour') eq 'MARC21' ) {
550 $marcrecordauth->leader(' nz a22 o 4500');
551 SetMarcUnicodeFlag( $marcrecordauth, 'MARC21' );
553 $field->delete_subfield( code => '9' )
554 if defined $current_link;
556 MARC::Field->new( $authority_type->auth_tag_to_report,
557 '', '', "a" => "" . $field->subfield('a') );
559 $authfield->add_subfields( $_->[0] => $_->[1] )
560 if ( $_->[0] =~ /[A-z]/ && $_->[0] ne "a" )
561 } $field->subfields();
562 $marcrecordauth->insert_fields_ordered($authfield);
564 # bug 2317: ensure new authority knows it's using UTF-8; currently
565 # only need to do this for MARC21, as MARC::Record->as_xml_record() handles
566 # automatically for UNIMARC (by not transcoding)
567 # FIXME: AddAuthority() instead should simply explicitly require that the MARC::Record
568 # use UTF-8, but as of 2008-08-05, did not want to introduce that kind
569 # of change to a core API just before the 3.0 release.
571 if ( C4::Context->preference('marcflavour') eq 'MARC21' ) {
572 $marcrecordauth->insert_fields_ordered(
575 'a' => "Machine generated authority record."
579 $bib->author() . ", "
580 . $bib->title_proper() . ", "
581 . $bib->publication_date() . " ";
582 $cite =~ s/^[\s\,]*//;
583 $cite =~ s/[\s\,]*$//;
586 . C4::Context->preference('MARCOrgCode') . ")"
587 . $bib->subfield( '999', 'c' ) . ": "
589 $marcrecordauth->insert_fields_ordered(
590 MARC::Field->new( '670', '', '', 'a' => $cite ) );
593 # warn "AUTH RECORD ADDED : ".$marcrecordauth->as_formatted;
596 C4::AuthoritiesMarc::AddAuthority( $marcrecordauth, '',
597 $heading->auth_type() );
598 $field->add_subfields( '9', $authid );
599 $num_headings_changed++;
600 $linker->update_cache($heading, $authid);
601 $results{'added'}->{ $heading->display_form() }++;
604 elsif ( defined $current_link ) {
605 if ( _check_valid_auth_link( $current_link, $field ) ) {
606 $results{'linked'}->{ $heading->display_form() }++;
609 $field->delete_subfield( code => '9' );
610 $num_headings_changed++;
611 $results{'unlinked'}->{ $heading->display_form() }++;
615 $results{'unlinked'}->{ $heading->display_form() }++;
620 return $num_headings_changed, \%results;
623 =head2 _check_valid_auth_link
625 if ( _check_valid_auth_link($authid, $field) ) {
629 Check whether the specified heading-auth link is valid without reference
630 to Zebra. Ideally this code would be in C4::Heading, but that won't be
631 possible until we have de-cycled C4::AuthoritiesMarc, so this is the
636 sub _check_valid_auth_link {
637 my ( $authid, $field ) = @_;
639 require C4::AuthoritiesMarc;
641 my $authorized_heading =
642 C4::AuthoritiesMarc::GetAuthorizedHeading( { 'authid' => $authid } ) || '';
644 return ($field->as_string('abcdefghijklmnopqrstuvwxyz') eq $authorized_heading);
647 =head2 GetRecordValue
649 my $values = GetRecordValue($field, $record, $frameworkcode);
651 Get MARC fields from a keyword defined in fieldmapping table.
656 my ( $field, $record, $frameworkcode ) = @_;
659 carp 'GetRecordValue called with undefined record';
662 my $dbh = C4::Context->dbh;
664 my $sth = $dbh->prepare('SELECT fieldcode, subfieldcode FROM fieldmapping WHERE frameworkcode = ? AND field = ?');
665 $sth->execute( $frameworkcode, $field );
669 while ( my $row = $sth->fetchrow_hashref ) {
670 foreach my $field ( $record->field( $row->{fieldcode} ) ) {
671 if ( ( $row->{subfieldcode} ne "" && $field->subfield( $row->{subfieldcode} ) ) ) {
672 foreach my $subfield ( $field->subfield( $row->{subfieldcode} ) ) {
673 push @result, { 'subfield' => $subfield };
676 } elsif ( $row->{subfieldcode} eq "" ) {
677 push @result, { 'subfield' => $field->as_string() };
687 $data = &GetBiblioData($biblionumber);
689 Returns information about the book with the given biblionumber.
690 C<&GetBiblioData> returns a reference-to-hash. The keys are the fields in
691 the C<biblio> and C<biblioitems> tables in the
694 In addition, C<$data-E<gt>{subject}> is the list of the book's
695 subjects, separated by C<" , "> (space, comma, space).
696 If there are multiple biblioitems with the given biblionumber, only
697 the first one is considered.
703 my $dbh = C4::Context->dbh;
705 my $query = " SELECT * , biblioitems.notes AS bnotes, itemtypes.notforloan as bi_notforloan, biblio.notes
707 LEFT JOIN biblioitems ON biblio.biblionumber = biblioitems.biblionumber
708 LEFT JOIN itemtypes ON biblioitems.itemtype = itemtypes.itemtype
709 WHERE biblio.biblionumber = ?";
711 my $sth = $dbh->prepare($query);
712 $sth->execute($bibnum);
714 $data = $sth->fetchrow_hashref;
718 } # sub GetBiblioData
720 =head2 &GetBiblioItemData
722 $itemdata = &GetBiblioItemData($biblioitemnumber);
724 Looks up the biblioitem with the given biblioitemnumber. Returns a
725 reference-to-hash. The keys are the fields from the C<biblio>,
726 C<biblioitems>, and C<itemtypes> tables in the Koha database, except
727 that C<biblioitems.notes> is given as C<$itemdata-E<gt>{bnotes}>.
732 sub GetBiblioItemData {
733 my ($biblioitemnumber) = @_;
734 my $dbh = C4::Context->dbh;
735 my $query = "SELECT *,biblioitems.notes AS bnotes
736 FROM biblio LEFT JOIN biblioitems on biblio.biblionumber=biblioitems.biblionumber ";
737 unless ( C4::Context->preference('item-level_itypes') ) {
738 $query .= "LEFT JOIN itemtypes on biblioitems.itemtype=itemtypes.itemtype ";
740 $query .= " WHERE biblioitemnumber = ? ";
741 my $sth = $dbh->prepare($query);
743 $sth->execute($biblioitemnumber);
744 $data = $sth->fetchrow_hashref;
747 } # sub &GetBiblioItemData
749 =head2 GetBiblioItemByBiblioNumber
751 NOTE : This function has been copy/paste from C4/Biblio.pm from head before zebra integration.
755 sub GetBiblioItemByBiblioNumber {
756 my ($biblionumber) = @_;
757 my $dbh = C4::Context->dbh;
758 my $sth = $dbh->prepare("Select * FROM biblioitems WHERE biblionumber = ?");
762 $sth->execute($biblionumber);
764 while ( my $data = $sth->fetchrow_hashref ) {
765 push @results, $data;
774 $isbd = &GetISBDView({
775 'record' => $marc_record,
776 'template' => $interface, # opac/intranet
777 'framework' => $framework,
780 Return the ISBD view which can be included in opac and intranet
787 # Expecting record WITH items.
788 my $record = $params->{record};
789 return unless defined $record;
791 my $template = $params->{template} // q{};
792 my $sysprefname = $template eq 'opac' ? 'opacisbd' : 'isbd';
793 my $framework = $params->{framework};
794 my $itemtype = $framework;
795 my ( $holdingbrtagf, $holdingbrtagsubf ) = &GetMarcFromKohaField( "items.holdingbranch", $itemtype );
796 my $tagslib = &GetMarcStructure( 1, $itemtype, { unsafe => 1 } );
798 my $ISBD = C4::Context->preference($sysprefname);
803 foreach my $isbdfield ( split( /#/, $bloc ) ) {
805 # $isbdfield= /(.?.?.?)/;
806 $isbdfield =~ /(\d\d\d)([^\|])?\|(.*)\|(.*)\|(.*)/;
807 my $fieldvalue = $1 || 0;
808 my $subfvalue = $2 || "";
810 my $analysestring = $4;
813 # warn "==> $1 / $2 / $3 / $4";
814 # my $fieldvalue=substr($isbdfield,0,3);
815 if ( $fieldvalue > 0 ) {
816 my $hasputtextbefore = 0;
817 my @fieldslist = $record->field($fieldvalue);
818 @fieldslist = sort { $a->subfield($holdingbrtagsubf) cmp $b->subfield($holdingbrtagsubf) } @fieldslist if ( $fieldvalue eq $holdingbrtagf );
820 # warn "ERROR IN ISBD DEFINITION at : $isbdfield" unless $fieldvalue;
821 # warn "FV : $fieldvalue";
822 if ( $subfvalue ne "" ) {
823 # OPAC hidden subfield
825 if ( ( $template eq 'opac' )
826 && ( $tagslib->{$fieldvalue}->{$subfvalue}->{'hidden'} || 0 ) > 0 );
827 foreach my $field (@fieldslist) {
828 foreach my $subfield ( $field->subfield($subfvalue) ) {
829 my $calculated = $analysestring;
830 my $tag = $field->tag();
833 my $subfieldvalue = GetAuthorisedValueDesc( $tag, $subfvalue, $subfield, '', $tagslib );
834 my $tagsubf = $tag . $subfvalue;
835 $calculated =~ s/\{(.?.?.?.?)$tagsubf(.*?)\}/$1$subfieldvalue$2\{$1$tagsubf$2\}/g;
836 if ( $template eq "opac" ) { $calculated =~ s#/cgi-bin/koha/[^/]+/([^.]*.pl\?.*)$#opac-$1#g; }
838 # field builded, store the result
839 if ( $calculated && !$hasputtextbefore ) { # put textbefore if not done
840 $blocres .= $textbefore;
841 $hasputtextbefore = 1;
844 # remove punctuation at start
845 $calculated =~ s/^( |;|:|\.|-)*//g;
846 $blocres .= $calculated;
851 $blocres .= $textafter if $hasputtextbefore;
853 foreach my $field (@fieldslist) {
854 my $calculated = $analysestring;
855 my $tag = $field->tag();
858 my @subf = $field->subfields;
859 for my $i ( 0 .. $#subf ) {
860 my $valuecode = $subf[$i][1];
861 my $subfieldcode = $subf[$i][0];
862 # OPAC hidden subfield
864 if ( ( $template eq 'opac' )
865 && ( $tagslib->{$fieldvalue}->{$subfieldcode}->{'hidden'} || 0 ) > 0 );
866 my $subfieldvalue = GetAuthorisedValueDesc( $tag, $subf[$i][0], $subf[$i][1], '', $tagslib );
867 my $tagsubf = $tag . $subfieldcode;
869 $calculated =~ s/ # replace all {{}} codes by the value code.
870 \{\{$tagsubf\}\} # catch the {{actualcode}}
872 $valuecode # replace by the value code
875 $calculated =~ s/\{(.?.?.?.?)$tagsubf(.*?)\}/$1$subfieldvalue$2\{$1$tagsubf$2\}/g;
876 if ( $template eq "opac" ) { $calculated =~ s#/cgi-bin/koha/[^/]+/([^.]*.pl\?.*)$#opac-$1#g; }
879 # field builded, store the result
880 if ( $calculated && !$hasputtextbefore ) { # put textbefore if not done
881 $blocres .= $textbefore;
882 $hasputtextbefore = 1;
885 # remove punctuation at start
886 $calculated =~ s/^( |;|:|\.|-)*//g;
887 $blocres .= $calculated;
890 $blocres .= $textafter if $hasputtextbefore;
893 $blocres .= $isbdfield;
898 $res =~ s/\{(.*?)\}//g;
900 $res =~ s/\n/<br\/>/g;
908 =head2 GetBiblioItemInfosOf
910 GetBiblioItemInfosOf(@biblioitemnumbers);
914 sub GetBiblioItemInfosOf {
915 my @biblioitemnumbers = @_;
917 my $biblioitemnumber_values = @biblioitemnumbers ? join( ',', @biblioitemnumbers ) : "''";
919 my $dbh = C4::Context->dbh;
921 SELECT biblioitemnumber,
925 WHERE biblioitemnumber IN ($biblioitemnumber_values)
927 return $dbh->selectall_hashref($query, 'biblioitemnumber');
930 =head1 FUNCTIONS FOR HANDLING MARC MANAGEMENT
932 =head2 IsMarcStructureInternal
934 my $tagslib = C4::Biblio::GetMarcStructure();
935 for my $tag ( sort keys %$tagslib ) {
937 for my $subfield ( sort keys %{ $tagslib->{$tag} } ) {
938 next if IsMarcStructureInternal($tagslib->{$tag}{$subfield});
943 GetMarcStructure creates keys (lib, tab, mandatory, repeatable) for a display purpose.
944 These different values should not be processed as valid subfields.
948 sub IsMarcStructureInternal {
949 my ( $subfield ) = @_;
950 return ref $subfield ? 0 : 1;
953 =head2 GetMarcStructure
955 $res = GetMarcStructure($forlibrarian, $frameworkcode, [ $params ]);
957 Returns a reference to a big hash of hash, with the Marc structure for the given frameworkcode
958 $forlibrarian :if set to 1, the MARC descriptions are the librarians ones, otherwise it's the public (OPAC) ones
959 $frameworkcode : the framework code to read
960 $params allows you to pass { unsafe => 1 } for better performance.
962 Note: If you call GetMarcStructure with unsafe => 1, do not modify or
963 even autovivify its contents. It is a cached/shared data structure. Your
964 changes c/would be passed around in subsequent calls.
968 sub GetMarcStructure {
969 my ( $forlibrarian, $frameworkcode, $params ) = @_;
970 $frameworkcode = "" unless $frameworkcode;
972 $forlibrarian = $forlibrarian ? 1 : 0;
973 my $unsafe = ($params && $params->{unsafe})? 1: 0;
974 my $cache = Koha::Caches->get_instance();
975 my $cache_key = "MarcStructure-$forlibrarian-$frameworkcode";
976 my $cached = $cache->get_from_cache($cache_key, { unsafe => $unsafe });
977 return $cached if $cached;
979 my $dbh = C4::Context->dbh;
980 my $sth = $dbh->prepare(
981 "SELECT tagfield,liblibrarian,libopac,mandatory,repeatable
982 FROM marc_tag_structure
983 WHERE frameworkcode=?
986 $sth->execute($frameworkcode);
987 my ( $liblibrarian, $libopac, $tag, $res, $tab, $mandatory, $repeatable );
989 while ( ( $tag, $liblibrarian, $libopac, $mandatory, $repeatable ) = $sth->fetchrow ) {
990 $res->{$tag}->{lib} = ( $forlibrarian or !$libopac ) ? $liblibrarian : $libopac;
991 $res->{$tag}->{tab} = "";
992 $res->{$tag}->{mandatory} = $mandatory;
993 $res->{$tag}->{repeatable} = $repeatable;
996 $sth = $dbh->prepare(
997 "SELECT tagfield,tagsubfield,liblibrarian,libopac,tab,mandatory,repeatable,authorised_value,authtypecode,value_builder,kohafield,seealso,hidden,isurl,link,defaultvalue,maxlength
998 FROM marc_subfield_structure
999 WHERE frameworkcode=?
1000 ORDER BY tagfield,tagsubfield
1004 $sth->execute($frameworkcode);
1007 my $authorised_value;
1019 ( $tag, $subfield, $liblibrarian, $libopac, $tab, $mandatory, $repeatable, $authorised_value,
1020 $authtypecode, $value_builder, $kohafield, $seealso, $hidden, $isurl, $link, $defaultvalue,
1025 $res->{$tag}->{$subfield}->{lib} = ( $forlibrarian or !$libopac ) ? $liblibrarian : $libopac;
1026 $res->{$tag}->{$subfield}->{tab} = $tab;
1027 $res->{$tag}->{$subfield}->{mandatory} = $mandatory;
1028 $res->{$tag}->{$subfield}->{repeatable} = $repeatable;
1029 $res->{$tag}->{$subfield}->{authorised_value} = $authorised_value;
1030 $res->{$tag}->{$subfield}->{authtypecode} = $authtypecode;
1031 $res->{$tag}->{$subfield}->{value_builder} = $value_builder;
1032 $res->{$tag}->{$subfield}->{kohafield} = $kohafield;
1033 $res->{$tag}->{$subfield}->{seealso} = $seealso;
1034 $res->{$tag}->{$subfield}->{hidden} = $hidden;
1035 $res->{$tag}->{$subfield}->{isurl} = $isurl;
1036 $res->{$tag}->{$subfield}->{'link'} = $link;
1037 $res->{$tag}->{$subfield}->{defaultvalue} = $defaultvalue;
1038 $res->{$tag}->{$subfield}->{maxlength} = $maxlength;
1041 $cache->set_in_cache($cache_key, $res);
1045 =head2 GetUsedMarcStructure
1047 The same function as GetMarcStructure except it just takes field
1048 in tab 0-9. (used field)
1050 my $results = GetUsedMarcStructure($frameworkcode);
1052 C<$results> is a ref to an array which each case containts a ref
1053 to a hash which each keys is the columns from marc_subfield_structure
1055 C<$frameworkcode> is the framework code.
1059 sub GetUsedMarcStructure {
1060 my $frameworkcode = shift || '';
1063 FROM marc_subfield_structure
1065 AND frameworkcode = ?
1066 ORDER BY tagfield, tagsubfield
1068 my $sth = C4::Context->dbh->prepare($query);
1069 $sth->execute($frameworkcode);
1070 return $sth->fetchall_arrayref( {} );
1073 =head2 GetMarcSubfieldStructure
1077 sub GetMarcSubfieldStructure {
1078 my ( $frameworkcode ) = @_;
1080 $frameworkcode //= '';
1082 my $cache = Koha::Caches->get_instance();
1083 my $cache_key = "MarcSubfieldStructure-$frameworkcode";
1084 my $cached = $cache->get_from_cache($cache_key);
1085 return $cached if $cached;
1087 my $dbh = C4::Context->dbh;
1088 my $subfield_structure = $dbh->selectall_hashref( q|
1090 FROM marc_subfield_structure
1091 WHERE frameworkcode = ?
1093 |, 'kohafield', {}, $frameworkcode );
1095 $cache->set_in_cache( $cache_key, $subfield_structure );
1096 return $subfield_structure;
1099 =head2 GetMarcFromKohaField
1101 ($MARCfield,$MARCsubfield)=GetMarcFromKohaField($kohafield,$frameworkcode);
1103 Returns the MARC fields & subfields mapped to the koha field
1104 for the given frameworkcode or default framework if $frameworkcode is missing
1108 sub GetMarcFromKohaField {
1109 my ( $kohafield, $frameworkcode ) = @_;
1110 return (0, undef) unless $kohafield;
1111 my $mss = GetMarcSubfieldStructure( $frameworkcode );
1112 return ( $mss->{$kohafield}{tagfield}, $mss->{$kohafield}{tagsubfield} );
1115 =head2 GetMarcSubfieldStructureFromKohaField
1117 my $subfield_structure = &GetMarcSubfieldStructureFromKohaField($kohafield, $frameworkcode);
1119 Returns a hashref where keys are marc_subfield_structure column names for the
1120 row where kohafield=$kohafield for the given framework code.
1122 $frameworkcode is optional. If not given, then the default framework is used.
1126 sub GetMarcSubfieldStructureFromKohaField {
1127 my ( $kohafield, $frameworkcode ) = @_;
1129 return unless $kohafield;
1131 my $mss = GetMarcSubfieldStructure( $frameworkcode );
1132 return exists $mss->{$kohafield}
1133 ? $mss->{$kohafield}
1137 =head2 GetMarcBiblio
1139 my $record = GetMarcBiblio($biblionumber, [$embeditems], [$opac]);
1141 Returns MARC::Record representing a biblio record, or C<undef> if the
1142 biblionumber doesn't exist.
1146 =item C<$biblionumber>
1150 =item C<$embeditems>
1152 set to true to include item information.
1156 set to true to make the result suited for OPAC view. This causes things like
1157 OpacHiddenItems to be applied.
1164 my $biblionumber = shift;
1165 my $embeditems = shift || 0;
1166 my $opac = shift || 0;
1168 if (not defined $biblionumber) {
1169 carp 'GetMarcBiblio called with undefined biblionumber';
1173 my $dbh = C4::Context->dbh;
1174 my $sth = $dbh->prepare("SELECT biblioitemnumber FROM biblioitems WHERE biblionumber=? ");
1175 $sth->execute($biblionumber);
1176 my $row = $sth->fetchrow_hashref;
1177 my $biblioitemnumber = $row->{'biblioitemnumber'};
1178 my $marcxml = GetXmlBiblio( $biblionumber );
1179 $marcxml = StripNonXmlChars( $marcxml );
1180 my $frameworkcode = GetFrameworkCode($biblionumber);
1181 MARC::File::XML->default_record_format( C4::Context->preference('marcflavour') );
1182 my $record = MARC::Record->new();
1186 MARC::Record::new_from_xml( $marcxml, "utf8",
1187 C4::Context->preference('marcflavour') );
1189 if ($@) { warn " problem with :$biblionumber : $@ \n$marcxml"; }
1190 return unless $record;
1192 C4::Biblio::_koha_marc_update_bib_ids( $record, $frameworkcode, $biblionumber,
1193 $biblioitemnumber );
1194 C4::Biblio::EmbedItemsInMarcBiblio( $record, $biblionumber, undef, $opac )
1206 my $marcxml = GetXmlBiblio($biblionumber);
1208 Returns biblio_metadata.metadata/marcxml of the biblionumber passed in parameter.
1209 The XML should only contain biblio information (item information is no longer stored in marcxml field)
1214 my ($biblionumber) = @_;
1215 my $dbh = C4::Context->dbh;
1216 return unless $biblionumber;
1217 my ($marcxml) = $dbh->selectrow_array(
1220 FROM biblio_metadata
1221 WHERE biblionumber=?
1222 AND format='marcxml'
1224 |, undef, $biblionumber, C4::Context->preference('marcflavour')
1229 =head2 GetCOinSBiblio
1231 my $coins = GetCOinSBiblio($record);
1233 Returns the COinS (a span) which can be included in a biblio record
1237 sub GetCOinSBiblio {
1240 # get the coin format
1242 carp 'GetCOinSBiblio called with undefined record';
1245 my $pos7 = substr $record->leader(), 7, 1;
1246 my $pos6 = substr $record->leader(), 6, 1;
1249 my ( $aulast, $aufirst ) = ( '', '' );
1258 my $titletype = 'b';
1260 # For the purposes of generating COinS metadata, LDR/06-07 can be
1261 # considered the same for UNIMARC and MARC21
1266 'b' => 'manuscript',
1268 'd' => 'manuscript',
1272 'i' => 'audioRecording',
1273 'j' => 'audioRecording',
1276 'm' => 'computerProgram',
1281 'a' => 'journalArticle',
1285 $genre = $fmts6->{$pos6} ? $fmts6->{$pos6} : 'book';
1287 if ( $genre eq 'book' ) {
1288 $genre = $fmts7->{$pos7} if $fmts7->{$pos7};
1291 ##### We must transform mtx to a valable mtx and document type ####
1292 if ( $genre eq 'book' ) {
1294 } elsif ( $genre eq 'journal' ) {
1297 } elsif ( $genre eq 'journalArticle' ) {
1305 $genre = ( $mtx eq 'dc' ) ? "&rft.type=$genre" : "&rft.genre=$genre";
1307 if ( C4::Context->preference("marcflavour") eq "UNIMARC" ) {
1310 $aulast = $record->subfield( '700', 'a' ) || '';
1311 $aufirst = $record->subfield( '700', 'b' ) || '';
1312 $oauthors = "&rft.au=$aufirst $aulast";
1315 if ( $record->field('200') ) {
1316 for my $au ( $record->field('200')->subfield('g') ) {
1317 $oauthors .= "&rft.au=$au";
1322 ? "&rft.title=" . $record->subfield( '200', 'a' )
1323 : "&rft.title=" . $record->subfield( '200', 'a' ) . "&rft.btitle=" . $record->subfield( '200', 'a' );
1324 $pubyear = $record->subfield( '210', 'd' ) || '';
1325 $publisher = $record->subfield( '210', 'c' ) || '';
1326 $isbn = $record->subfield( '010', 'a' ) || '';
1327 $issn = $record->subfield( '011', 'a' ) || '';
1330 # MARC21 need some improve
1333 if ( $record->field('100') ) {
1334 $oauthors .= "&rft.au=" . $record->subfield( '100', 'a' );
1338 if ( $record->field('700') ) {
1339 for my $au ( $record->field('700')->subfield('a') ) {
1340 $oauthors .= "&rft.au=$au";
1343 $title = "&rft." . $titletype . "title=" . $record->subfield( '245', 'a' );
1344 $subtitle = $record->subfield( '245', 'b' ) || '';
1345 $title .= $subtitle;
1346 if ($titletype eq 'a') {
1347 $pubyear = $record->field('008') || '';
1348 $pubyear = substr($pubyear->data(), 7, 4) if $pubyear;
1349 $isbn = $record->subfield( '773', 'z' ) || '';
1350 $issn = $record->subfield( '773', 'x' ) || '';
1351 if ($mtx eq 'journal') {
1352 $title .= "&rft.title=" . (($record->subfield( '773', 't' ) || $record->subfield( '773', 'a')));
1354 $title .= "&rft.btitle=" . (($record->subfield( '773', 't' ) || $record->subfield( '773', 'a')) || '');
1356 foreach my $rel ($record->subfield( '773', 'g' )) {
1363 $pubyear = $record->subfield( '260', 'c' ) || '';
1364 $publisher = $record->subfield( '260', 'b' ) || '';
1365 $isbn = $record->subfield( '020', 'a' ) || '';
1366 $issn = $record->subfield( '022', 'a' ) || '';
1371 "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";
1372 $coins_value =~ s/(\ |&[^a])/\+/g;
1373 $coins_value =~ s/\"/\"\;/g;
1375 #<!-- 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="
1377 return $coins_value;
1383 return the prices in accordance with the Marc format.
1385 returns 0 if no price found
1386 returns undef if called without a marc record or with
1387 an unrecognized marc format
1392 my ( $record, $marcflavour ) = @_;
1394 carp 'GetMarcPrice called on undefined record';
1401 if ( $marcflavour eq "MARC21" || $marcflavour eq "NORMARC" ) {
1402 @listtags = ('345', '020');
1404 } elsif ( $marcflavour eq "UNIMARC" ) {
1405 @listtags = ('345', '010');
1411 for my $field ( $record->field(@listtags) ) {
1412 for my $subfield_value ($field->subfield($subfield)){
1414 $subfield_value = MungeMarcPrice( $subfield_value );
1415 return $subfield_value if ($subfield_value);
1418 return 0; # no price found
1421 =head2 MungeMarcPrice
1423 Return the best guess at what the actual price is from a price field.
1427 sub MungeMarcPrice {
1429 return unless ( $price =~ m/\d/ ); ## No digits means no price.
1430 # Look for the currency symbol and the normalized code of the active currency, if it's there,
1431 my $active_currency = Koha::Acquisition::Currencies->get_active;
1432 my $symbol = $active_currency->symbol;
1433 my $isocode = $active_currency->isocode;
1434 $isocode = $active_currency->currency unless defined $isocode;
1437 my @matches =($price=~ /
1439 ( # start of capturing parenthesis
1441 (?:[\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'
1442 |(?:\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'
1444 \s?\p{Sc}?\s? # followed or not by a whitespace. \p{Sc}?\s? are for cases like '25$ USD'
1446 (?:[\p{Sc}\p{L}\/.]){1,4} # followed by same block as symbol block
1447 |(?:\d+[\p{P}\s]?){1,4} # or by same block as digits block
1449 \s?\p{L}{0,4}\s? # followed or not by a whitespace. \p{L}{0,4}\s? are for cases like '$9.50 USD'
1450 ) # end of capturing parenthesis
1451 (?:\p{P}|\z) # followed by a punctuation sign or by the end of the string
1455 foreach ( @matches ) {
1456 $localprice = $_ and last if index($_, $isocode)>=0;
1458 if ( !$localprice ) {
1459 foreach ( @matches ) {
1460 $localprice = $_ and last if $_=~ /(^|[^\p{Sc}\p{L}\/])\Q$symbol\E([^\p{Sc}\p{L}\/]+\z|\z)/;
1465 if ( $localprice ) {
1466 $price = $localprice;
1468 ## Grab the first number in the string ( can use commas or periods for thousands separator and/or decimal separator )
1469 ( $price ) = $price =~ m/([\d\,\.]+[[\,\.]\d\d]?)/;
1471 # eliminate symbol/isocode, space and any final dot from the string
1472 $price =~ s/[\p{Sc}\p{L}\/ ]|\.$//g;
1473 # remove comma,dot when used as separators from hundreds
1474 $price =~s/[\,\.](\d{3})/$1/g;
1475 # convert comma to dot to ensure correct display of decimals if existing
1481 =head2 GetMarcQuantity
1483 return the quantity of a book. Used in acquisition only, when importing a file an iso2709 from a bookseller
1484 Warning : this is not really in the marc standard. In Unimarc, Electre (the most widely used bookseller) use the 969$a
1486 returns 0 if no quantity found
1487 returns undef if called without a marc record or with
1488 an unrecognized marc format
1492 sub GetMarcQuantity {
1493 my ( $record, $marcflavour ) = @_;
1495 carp 'GetMarcQuantity called on undefined record';
1502 if ( $marcflavour eq "MARC21" ) {
1504 } elsif ( $marcflavour eq "UNIMARC" ) {
1505 @listtags = ('969');
1511 for my $field ( $record->field(@listtags) ) {
1512 for my $subfield_value ($field->subfield($subfield)){
1514 if ($subfield_value) {
1515 # in France, the cents separator is the , but sometimes, ppl use a .
1516 # in this case, the price will be x100 when unformatted ! Replace the . by a , to get a proper price calculation
1517 $subfield_value =~ s/\./,/ if C4::Context->preference("CurrencyFormat") eq "FR";
1518 return $subfield_value;
1522 return 0; # no price found
1526 =head2 GetAuthorisedValueDesc
1528 my $subfieldvalue =get_authorised_value_desc(
1529 $tag, $subf[$i][0],$subf[$i][1], '', $taglib, $category, $opac);
1531 Retrieve the complete description for a given authorised value.
1533 Now takes $category and $value pair too.
1535 my $auth_value_desc =GetAuthorisedValueDesc(
1536 '','', 'DVD' ,'','','CCODE');
1538 If the optional $opac parameter is set to a true value, displays OPAC
1539 descriptions rather than normal ones when they exist.
1543 sub GetAuthorisedValueDesc {
1544 my ( $tag, $subfield, $value, $framework, $tagslib, $category, $opac ) = @_;
1548 return $value unless defined $tagslib->{$tag}->{$subfield}->{'authorised_value'};
1551 if ( $tagslib->{$tag}->{$subfield}->{'authorised_value'} eq "branches" ) {
1552 return Koha::Libraries->find($value)->branchname;
1556 if ( $tagslib->{$tag}->{$subfield}->{'authorised_value'} eq "itemtypes" ) {
1557 my $itemtype = Koha::ItemTypes->find( $value );
1558 return $itemtype ? $itemtype->translated_description : q||;
1561 #---- "true" authorized value
1562 $category = $tagslib->{$tag}->{$subfield}->{'authorised_value'};
1565 my $dbh = C4::Context->dbh;
1566 if ( $category ne "" ) {
1567 my $sth = $dbh->prepare( "SELECT lib, lib_opac FROM authorised_values WHERE category = ? AND authorised_value = ?" );
1568 $sth->execute( $category, $value );
1569 my $data = $sth->fetchrow_hashref;
1570 return ( $opac && $data->{'lib_opac'} ) ? $data->{'lib_opac'} : $data->{'lib'};
1572 return $value; # if nothing is found return the original value
1576 =head2 GetMarcControlnumber
1578 $marccontrolnumber = GetMarcControlnumber($record,$marcflavour);
1580 Get the control number / record Identifier from the MARC record and return it.
1584 sub GetMarcControlnumber {
1585 my ( $record, $marcflavour ) = @_;
1587 carp 'GetMarcControlnumber called on undefined record';
1590 my $controlnumber = "";
1591 # Control number or Record identifier are the same field in MARC21, UNIMARC and NORMARC
1592 # Keep $marcflavour for possible later use
1593 if ($marcflavour eq "MARC21" || $marcflavour eq "UNIMARC" || $marcflavour eq "NORMARC") {
1594 my $controlnumberField = $record->field('001');
1595 if ($controlnumberField) {
1596 $controlnumber = $controlnumberField->data();
1599 return $controlnumber;
1604 $marcisbnsarray = GetMarcISBN( $record, $marcflavour );
1606 Get all ISBNs from the MARC record and returns them in an array.
1607 ISBNs stored in different fields depending on MARC flavour
1612 my ( $record, $marcflavour ) = @_;
1614 carp 'GetMarcISBN called on undefined record';
1618 if ( $marcflavour eq "UNIMARC" ) {
1620 } else { # assume marc21 if not unimarc
1625 foreach my $field ( $record->field($scope) ) {
1626 my $isbn = $field->subfield( 'a' );
1627 if ( $isbn ne "" ) {
1628 push @marcisbns, $isbn;
1638 $marcissnsarray = GetMarcISSN( $record, $marcflavour );
1640 Get all valid ISSNs from the MARC record and returns them in an array.
1641 ISSNs are stored in different fields depending on MARC flavour
1646 my ( $record, $marcflavour ) = @_;
1648 carp 'GetMarcISSN called on undefined record';
1652 if ( $marcflavour eq "UNIMARC" ) {
1655 else { # assume MARC21 or NORMARC
1659 foreach my $field ( $record->field($scope) ) {
1660 push @marcissns, $field->subfield( 'a' )
1661 if ( $field->subfield( 'a' ) ne "" );
1668 $marcnotesarray = GetMarcNotes( $record, $marcflavour );
1670 Get all notes from the MARC record and returns them in an array.
1671 The notes are stored in different fields depending on MARC flavour.
1672 MARC21 field 555 gets special attention for the $u subfields.
1677 my ( $record, $marcflavour ) = @_;
1679 carp 'GetMarcNotes called on undefined record';
1683 my $scope = $marcflavour eq "UNIMARC"? '3..': '5..';
1685 my %blacklist = map { $_ => 1 }
1686 split( /,/, C4::Context->preference('NotesBlacklist'));
1687 foreach my $field ( $record->field($scope) ) {
1688 my $tag = $field->tag();
1689 next if $blacklist{ $tag };
1690 if( $marcflavour ne 'UNIMARC' && $tag =~ /555/ ) {
1691 # Field 555$u contains URLs
1692 # We first push the regular subfields and all $u's separately
1693 # Leave further actions to the template
1694 push @marcnotes, { marcnote => $field->as_string('abcd') };
1695 foreach my $sub ( $field->subfield('u') ) {
1696 push @marcnotes, { marcnote => $sub };
1699 push @marcnotes, { marcnote => $field->as_string() };
1705 =head2 GetMarcSubjects
1707 $marcsubjcts = GetMarcSubjects($record,$marcflavour);
1709 Get all subjects from the MARC record and returns them in an array.
1710 The subjects are stored in different fields depending on MARC flavour
1714 sub GetMarcSubjects {
1715 my ( $record, $marcflavour ) = @_;
1717 carp 'GetMarcSubjects called on undefined record';
1720 my ( $mintag, $maxtag, $fields_filter );
1721 if ( $marcflavour eq "UNIMARC" ) {
1724 $fields_filter = '6..';
1725 } else { # marc21/normarc
1728 $fields_filter = '6..';
1733 my $subject_limit = C4::Context->preference("TraceCompleteSubfields") ? 'su,complete-subfield' : 'su';
1734 my $AuthoritySeparator = C4::Context->preference('AuthoritySeparator');
1736 foreach my $field ( $record->field($fields_filter) ) {
1737 next unless ($field->tag() >= $mintag && $field->tag() <= $maxtag);
1739 my @subfields = $field->subfields();
1742 # if there is an authority link, build the links with an= subfield9
1743 my $subfield9 = $field->subfield('9');
1746 my $linkvalue = $subfield9;
1747 $linkvalue =~ s/(\(|\))//g;
1748 @link_loop = ( { limit => 'an', 'link' => $linkvalue } );
1749 $authoritylink = $linkvalue
1753 for my $subject_subfield (@subfields) {
1754 next if ( $subject_subfield->[0] eq '9' );
1756 # don't load unimarc subfields 3,4,5
1757 next if ( ( $marcflavour eq "UNIMARC" ) and ( $subject_subfield->[0] =~ /2|3|4|5/ ) );
1758 # don't load MARC21 subfields 2 (FIXME: any more subfields??)
1759 next if ( ( $marcflavour eq "MARC21" ) and ( $subject_subfield->[0] =~ /2/ ) );
1761 my $code = $subject_subfield->[0];
1762 my $value = $subject_subfield->[1];
1763 my $linkvalue = $value;
1764 $linkvalue =~ s/(\(|\))//g;
1765 # if no authority link, build a search query
1766 unless ($subfield9) {
1768 limit => $subject_limit,
1769 'link' => $linkvalue,
1770 operator => (scalar @link_loop) ? ' and ' : undef
1773 my @this_link_loop = @link_loop;
1775 unless ( $code eq '0' ) {
1776 push @subfields_loop, {
1779 link_loop => \@this_link_loop,
1780 separator => (scalar @subfields_loop) ? $AuthoritySeparator : ''
1785 push @marcsubjects, {
1786 MARCSUBJECT_SUBFIELDS_LOOP => \@subfields_loop,
1787 authoritylink => $authoritylink,
1788 } if $authoritylink || @subfields_loop;
1791 return \@marcsubjects;
1792 } #end getMARCsubjects
1794 =head2 GetMarcAuthors
1796 authors = GetMarcAuthors($record,$marcflavour);
1798 Get all authors from the MARC record and returns them in an array.
1799 The authors are stored in different fields depending on MARC flavour
1803 sub GetMarcAuthors {
1804 my ( $record, $marcflavour ) = @_;
1806 carp 'GetMarcAuthors called on undefined record';
1809 my ( $mintag, $maxtag, $fields_filter );
1811 # tagslib useful only for UNIMARC author responsibilities
1813 if ( $marcflavour eq "UNIMARC" ) {
1814 # FIXME : we don't have the framework available, we take the default framework. May be buggy on some setups, will be usually correct.
1815 $tagslib = GetMarcStructure( 1, '', { unsafe => 1 });
1818 $fields_filter = '7..';
1819 } else { # marc21/normarc
1822 $fields_filter = '7..';
1826 my $AuthoritySeparator = C4::Context->preference('AuthoritySeparator');
1828 foreach my $field ( $record->field($fields_filter) ) {
1829 next unless $field->tag() >= $mintag && $field->tag() <= $maxtag;
1832 my @subfields = $field->subfields();
1835 # if there is an authority link, build the link with Koha-Auth-Number: subfield9
1836 my $subfield9 = $field->subfield('9');
1838 my $linkvalue = $subfield9;
1839 $linkvalue =~ s/(\(|\))//g;
1840 @link_loop = ( { 'limit' => 'an', 'link' => $linkvalue } );
1845 for my $authors_subfield (@subfields) {
1846 next if ( $authors_subfield->[0] eq '9' );
1848 # unimarc3 contains the $3 of the author for UNIMARC.
1849 # For french academic libraries, it's the "ppn", and it's required for idref webservice
1850 $unimarc3 = $authors_subfield->[1] if $marcflavour eq 'UNIMARC' and $authors_subfield->[0] =~ /3/;
1852 # don't load unimarc subfields 3, 5
1853 next if ( $marcflavour eq 'UNIMARC' and ( $authors_subfield->[0] =~ /3|5/ ) );
1855 my $code = $authors_subfield->[0];
1856 my $value = $authors_subfield->[1];
1857 my $linkvalue = $value;
1858 $linkvalue =~ s/(\(|\))//g;
1859 # UNIMARC author responsibility
1860 if ( $marcflavour eq 'UNIMARC' and $code eq '4' ) {
1861 $value = GetAuthorisedValueDesc( $field->tag(), $code, $value, '', $tagslib );
1862 $linkvalue = "($value)";
1864 # if no authority link, build a search query
1865 unless ($subfield9) {
1868 'link' => $linkvalue,
1869 operator => (scalar @link_loop) ? ' and ' : undef
1872 my @this_link_loop = @link_loop;
1874 unless ( $code eq '0') {
1875 push @subfields_loop, {
1876 tag => $field->tag(),
1879 link_loop => \@this_link_loop,
1880 separator => (scalar @subfields_loop) ? $AuthoritySeparator : ''
1884 push @marcauthors, {
1885 MARCAUTHOR_SUBFIELDS_LOOP => \@subfields_loop,
1886 authoritylink => $subfield9,
1887 unimarc3 => $unimarc3
1890 return \@marcauthors;
1895 $marcurls = GetMarcUrls($record,$marcflavour);
1897 Returns arrayref of URLs from MARC data, suitable to pass to tmpl loop.
1898 Assumes web resources (not uncommon in MARC21 to omit resource type ind)
1903 my ( $record, $marcflavour ) = @_;
1905 carp 'GetMarcUrls called on undefined record';
1910 for my $field ( $record->field('856') ) {
1912 for my $note ( $field->subfield('z') ) {
1913 push @notes, { note => $note };
1915 my @urls = $field->subfield('u');
1916 foreach my $url (@urls) {
1917 $url =~ s/^\s+|\s+$//g; # trim
1919 if ( $marcflavour eq 'MARC21' ) {
1920 my $s3 = $field->subfield('3');
1921 my $link = $field->subfield('y');
1922 unless ( $url =~ /^\w+:/ ) {
1923 if ( $field->indicator(1) eq '7' ) {
1924 $url = $field->subfield('2') . "://" . $url;
1925 } elsif ( $field->indicator(1) eq '1' ) {
1926 $url = 'ftp://' . $url;
1929 # properly, this should be if ind1=4,
1930 # however we will assume http protocol since we're building a link.
1931 $url = 'http://' . $url;
1935 # TODO handle ind 2 (relationship)
1940 $marcurl->{'linktext'} = $link || $s3 || C4::Context->preference('URLLinkText') || $url;
1941 $marcurl->{'part'} = $s3 if ($link);
1942 $marcurl->{'toc'} = 1 if ( defined($s3) && $s3 =~ /^[Tt]able/ );
1944 $marcurl->{'linktext'} = $field->subfield('2') || C4::Context->preference('URLLinkText') || $url;
1945 $marcurl->{'MARCURL'} = $url;
1947 push @marcurls, $marcurl;
1953 =head2 GetMarcSeries
1955 $marcseriesarray = GetMarcSeries($record,$marcflavour);
1957 Get all series from the MARC record and returns them in an array.
1958 The series are stored in different fields depending on MARC flavour
1963 my ( $record, $marcflavour ) = @_;
1965 carp 'GetMarcSeries called on undefined record';
1969 my ( $mintag, $maxtag, $fields_filter );
1970 if ( $marcflavour eq "UNIMARC" ) {
1973 $fields_filter = '2..';
1974 } else { # marc21/normarc
1977 $fields_filter = '4..';
1981 my $AuthoritySeparator = C4::Context->preference('AuthoritySeparator');
1983 foreach my $field ( $record->field($fields_filter) ) {
1984 next unless $field->tag() >= $mintag && $field->tag() <= $maxtag;
1986 my @subfields = $field->subfields();
1989 for my $series_subfield (@subfields) {
1991 # ignore $9, used for authority link
1992 next if ( $series_subfield->[0] eq '9' );
1995 my $code = $series_subfield->[0];
1996 my $value = $series_subfield->[1];
1997 my $linkvalue = $value;
1998 $linkvalue =~ s/(\(|\))//g;
2000 # see if this is an instance of a volume
2001 if ( $code eq 'v' ) {
2006 'link' => $linkvalue,
2007 operator => (scalar @link_loop) ? ' and ' : undef
2010 if ($volume_number) {
2011 push @subfields_loop, { volumenum => $value };
2013 push @subfields_loop, {
2016 link_loop => \@link_loop,
2017 separator => (scalar @subfields_loop) ? $AuthoritySeparator : '',
2018 volumenum => $volume_number,
2022 push @marcseries, { MARCSERIES_SUBFIELDS_LOOP => \@subfields_loop };
2025 return \@marcseries;
2026 } #end getMARCseriess
2030 $marchostsarray = GetMarcHosts($record,$marcflavour);
2032 Get all host records (773s MARC21, 461 UNIMARC) from the MARC record and returns them in an array.
2037 my ( $record, $marcflavour ) = @_;
2039 carp 'GetMarcHosts called on undefined record';
2043 my ( $tag,$title_subf,$bibnumber_subf,$itemnumber_subf);
2044 $marcflavour ||="MARC21";
2045 if ( $marcflavour eq "MARC21" || $marcflavour eq "NORMARC" ) {
2048 $bibnumber_subf ="0";
2049 $itemnumber_subf='9';
2051 elsif ($marcflavour eq "UNIMARC") {
2054 $bibnumber_subf ="0";
2055 $itemnumber_subf='9';
2060 foreach my $field ( $record->field($tag)) {
2064 my $hostbiblionumber = $field->subfield("$bibnumber_subf");
2065 my $hosttitle = $field->subfield($title_subf);
2066 my $hostitemnumber=$field->subfield($itemnumber_subf);
2067 push @fields_loop, { hostbiblionumber => $hostbiblionumber, hosttitle => $hosttitle, hostitemnumber => $hostitemnumber};
2068 push @marchosts, { MARCHOSTS_FIELDS_LOOP => \@fields_loop };
2071 my $marchostsarray = \@marchosts;
2072 return $marchostsarray;
2075 =head2 UpsertMarcSubfield
2077 my $record = C4::Biblio::UpsertMarcSubfield($MARC::Record, $fieldTag, $subfieldCode, $subfieldContent);
2081 sub UpsertMarcSubfield {
2082 my ($record, $tag, $code, $content) = @_;
2083 my $f = $record->field($tag);
2086 $f->update( $code => $content );
2089 my $f = MARC::Field->new( $tag, '', '', $code => $content);
2090 $record->insert_fields_ordered( $f );
2094 =head2 UpsertMarcControlField
2096 my $record = C4::Biblio::UpsertMarcControlField($MARC::Record, $fieldTag, $content);
2100 sub UpsertMarcControlField {
2101 my ($record, $tag, $content) = @_;
2102 die "UpsertMarcControlField() \$tag '$tag' is not a control field\n" unless 0+$tag < 10;
2103 my $f = $record->field($tag);
2106 $f->update( $content );
2109 my $f = MARC::Field->new($tag, $content);
2110 $record->insert_fields_ordered( $f );
2114 =head2 GetFrameworkCode
2116 $frameworkcode = GetFrameworkCode( $biblionumber )
2120 sub GetFrameworkCode {
2121 my ($biblionumber) = @_;
2122 my $dbh = C4::Context->dbh;
2123 my $sth = $dbh->prepare("SELECT frameworkcode FROM biblio WHERE biblionumber=?");
2124 $sth->execute($biblionumber);
2125 my ($frameworkcode) = $sth->fetchrow;
2126 return $frameworkcode;
2129 =head2 TransformKohaToMarc
2131 $record = TransformKohaToMarc( $hash )
2133 This function builds partial MARC::Record from a hash
2134 Hash entries can be from biblio or biblioitems.
2136 This function is called in acquisition module, to create a basic catalogue
2137 entry from user entry
2142 sub TransformKohaToMarc {
2144 my $record = MARC::Record->new();
2145 SetMarcUnicodeFlag( $record, C4::Context->preference("marcflavour") );
2146 # FIXME Do not we want to get the marc subfield structure for the biblio framework?
2147 my $mss = GetMarcSubfieldStructure();
2149 while ( my ($kohafield, $value) = each %$hash ) {
2150 next unless exists $mss->{$kohafield};
2151 next unless $mss->{$kohafield};
2152 my $tagfield = $mss->{$kohafield}{tagfield} . '';
2153 my $tagsubfield = $mss->{$kohafield}{tagsubfield};
2154 foreach my $value ( split(/\s?\|\s?/, $value, -1) ) {
2155 next if $value eq '';
2156 $tag_hr->{$tagfield} //= [];
2157 push @{$tag_hr->{$tagfield}}, [($tagsubfield, $value)];
2160 foreach my $tag (sort keys %$tag_hr) {
2161 my @sfl = @{$tag_hr->{$tag}};
2162 @sfl = sort { $a->[0] cmp $b->[0]; } @sfl;
2163 @sfl = map { @{$_}; } @sfl;
2164 $record->insert_fields_ordered(
2165 MARC::Field->new($tag, " ", " ", @sfl)
2171 =head2 PrepHostMarcField
2173 $hostfield = PrepHostMarcField ( $hostbiblionumber,$hostitemnumber,$marcflavour )
2175 This function returns a host field populated with data from the host record, the field can then be added to an analytical record
2179 sub PrepHostMarcField {
2180 my ($hostbiblionumber,$hostitemnumber, $marcflavour) = @_;
2181 $marcflavour ||="MARC21";
2184 my $hostrecord = GetMarcBiblio($hostbiblionumber);
2185 my $item = C4::Items::GetItem($hostitemnumber);
2188 if ( $marcflavour eq "MARC21" || $marcflavour eq "NORMARC" ) {
2192 if ($hostrecord->subfield('100','a')){
2193 $mainentry = $hostrecord->subfield('100','a');
2194 } elsif ($hostrecord->subfield('110','a')){
2195 $mainentry = $hostrecord->subfield('110','a');
2197 $mainentry = $hostrecord->subfield('111','a');
2200 # qualification info
2202 if (my $field260 = $hostrecord->field('260')){
2203 $qualinfo = $field260->as_string( 'abc' );
2208 my $ed = $hostrecord->subfield('250','a');
2209 my $barcode = $item->{'barcode'};
2210 my $title = $hostrecord->subfield('245','a');
2212 # record control number, 001 with 003 and prefix
2214 if ($hostrecord->field('001')){
2215 $recctrlno = $hostrecord->field('001')->data();
2216 if ($hostrecord->field('003')){
2217 $recctrlno = '('.$hostrecord->field('003')->data().')'.$recctrlno;
2222 my $issn = $hostrecord->subfield('022','a');
2223 my $isbn = $hostrecord->subfield('020','a');
2226 $hostmarcfield = MARC::Field->new(
2228 '0' => $hostbiblionumber,
2229 '9' => $hostitemnumber,
2239 } elsif ($marcflavour eq "UNIMARC") {
2240 $hostmarcfield = MARC::Field->new(
2242 '0' => $hostbiblionumber,
2243 't' => $hostrecord->subfield('200','a'),
2244 '9' => $hostitemnumber
2248 return $hostmarcfield;
2251 =head2 TransformHtmlToXml
2253 $xml = TransformHtmlToXml( $tags, $subfields, $values, $indicator,
2254 $ind_tag, $auth_type )
2256 $auth_type contains :
2260 =item - nothing : rebuild a biblio. In UNIMARC the encoding is in 100$a pos 26/27
2262 =item - UNIMARCAUTH : rebuild an authority. In UNIMARC, the encoding is in 100$a pos 13/14
2264 =item - ITEM : rebuild an item : in UNIMARC, 100$a, it's in the biblio ! (otherwise, we would get 2 100 fields !)
2270 sub TransformHtmlToXml {
2271 my ( $tags, $subfields, $values, $indicator, $ind_tag, $auth_type ) = @_;
2272 # NOTE: The parameter $ind_tag is NOT USED -- BZ 11247
2274 my $xml = MARC::File::XML::header('UTF-8');
2275 $xml .= "<record>\n";
2276 $auth_type = C4::Context->preference('marcflavour') unless $auth_type;
2277 MARC::File::XML->default_record_format($auth_type);
2279 # in UNIMARC, field 100 contains the encoding
2280 # check that there is one, otherwise the
2281 # MARC::Record->new_from_xml will fail (and Koha will die)
2282 my $unimarc_and_100_exist = 0;
2283 $unimarc_and_100_exist = 1 if $auth_type eq 'ITEM'; # if we rebuild an item, no need of a 100 field
2288 for ( my $i = 0 ; $i < @$tags ; $i++ ) {
2290 if ( C4::Context->preference('marcflavour') eq 'UNIMARC' and @$tags[$i] eq "100" and @$subfields[$i] eq "a" ) {
2292 # if we have a 100 field and it's values are not correct, skip them.
2293 # if we don't have any valid 100 field, we will create a default one at the end
2294 my $enc = substr( @$values[$i], 26, 2 );
2295 if ( $enc eq '01' or $enc eq '50' or $enc eq '03' ) {
2296 $unimarc_and_100_exist = 1;
2301 @$values[$i] =~ s/&/&/g;
2302 @$values[$i] =~ s/</</g;
2303 @$values[$i] =~ s/>/>/g;
2304 @$values[$i] =~ s/"/"/g;
2305 @$values[$i] =~ s/'/'/g;
2307 if ( ( @$tags[$i] ne $prevtag ) ) {
2308 $j++ unless ( @$tags[$i] eq "" );
2309 my $indicator1 = eval { substr( @$indicator[$j], 0, 1 ) };
2310 my $indicator2 = eval { substr( @$indicator[$j], 1, 1 ) };
2311 my $ind1 = _default_ind_to_space($indicator1);
2313 if ( @$indicator[$j] ) {
2314 $ind2 = _default_ind_to_space($indicator2);
2316 warn "Indicator in @$tags[$i] is empty";
2320 $xml .= "</datafield>\n";
2321 if ( ( @$tags[$i] && @$tags[$i] > 10 )
2322 && ( @$values[$i] ne "" ) ) {
2323 $xml .= "<datafield tag=\"@$tags[$i]\" ind1=\"$ind1\" ind2=\"$ind2\">\n";
2324 $xml .= "<subfield code=\"@$subfields[$i]\">@$values[$i]</subfield>\n";
2330 if ( @$values[$i] ne "" ) {
2333 if ( @$tags[$i] eq "000" ) {
2334 $xml .= "<leader>@$values[$i]</leader>\n";
2337 # rest of the fixed fields
2338 } elsif ( @$tags[$i] < 10 ) {
2339 $xml .= "<controlfield tag=\"@$tags[$i]\">@$values[$i]</controlfield>\n";
2342 $xml .= "<datafield tag=\"@$tags[$i]\" ind1=\"$ind1\" ind2=\"$ind2\">\n";
2343 $xml .= "<subfield code=\"@$subfields[$i]\">@$values[$i]</subfield>\n";
2348 } else { # @$tags[$i] eq $prevtag
2349 my $indicator1 = eval { substr( @$indicator[$j], 0, 1 ) };
2350 my $indicator2 = eval { substr( @$indicator[$j], 1, 1 ) };
2351 my $ind1 = _default_ind_to_space($indicator1);
2353 if ( @$indicator[$j] ) {
2354 $ind2 = _default_ind_to_space($indicator2);
2356 warn "Indicator in @$tags[$i] is empty";
2359 if ( @$values[$i] eq "" ) {
2362 $xml .= "<datafield tag=\"@$tags[$i]\" ind1=\"$ind1\" ind2=\"$ind2\">\n";
2365 $xml .= "<subfield code=\"@$subfields[$i]\">@$values[$i]</subfield>\n";
2368 $prevtag = @$tags[$i];
2370 $xml .= "</datafield>\n" if $xml =~ m/<datafield/;
2371 if ( C4::Context->preference('marcflavour') eq 'UNIMARC' and !$unimarc_and_100_exist ) {
2373 # warn "SETTING 100 for $auth_type";
2374 my $string = strftime( "%Y%m%d", localtime(time) );
2376 # set 50 to position 26 is biblios, 13 if authorities
2378 $pos = 13 if $auth_type eq 'UNIMARCAUTH';
2379 $string = sprintf( "%-*s", 35, $string );
2380 substr( $string, $pos, 6, "50" );
2381 $xml .= "<datafield tag=\"100\" ind1=\"\" ind2=\"\">\n";
2382 $xml .= "<subfield code=\"a\">$string</subfield>\n";
2383 $xml .= "</datafield>\n";
2385 $xml .= "</record>\n";
2386 $xml .= MARC::File::XML::footer();
2390 =head2 _default_ind_to_space
2392 Passed what should be an indicator returns a space
2393 if its undefined or zero length
2397 sub _default_ind_to_space {
2399 if ( !defined $s || $s eq q{} ) {
2405 =head2 TransformHtmlToMarc
2407 L<$record> = TransformHtmlToMarc(L<$cgi>)
2408 L<$cgi> is the CGI object which containts the values for subfields
2410 'tag_010_indicator1_531951' ,
2411 'tag_010_indicator2_531951' ,
2412 'tag_010_code_a_531951_145735' ,
2413 'tag_010_subfield_a_531951_145735' ,
2414 'tag_200_indicator1_873510' ,
2415 'tag_200_indicator2_873510' ,
2416 'tag_200_code_a_873510_673465' ,
2417 'tag_200_subfield_a_873510_673465' ,
2418 'tag_200_code_b_873510_704318' ,
2419 'tag_200_subfield_b_873510_704318' ,
2420 'tag_200_code_e_873510_280822' ,
2421 'tag_200_subfield_e_873510_280822' ,
2422 'tag_200_code_f_873510_110730' ,
2423 'tag_200_subfield_f_873510_110730' ,
2425 L<$record> is the MARC::Record object.
2429 sub TransformHtmlToMarc {
2430 my ($cgi, $isbiblio) = @_;
2432 my @params = $cgi->multi_param();
2434 # explicitly turn on the UTF-8 flag for all
2435 # 'tag_' parameters to avoid incorrect character
2436 # conversion later on
2437 my $cgi_params = $cgi->Vars;
2438 foreach my $param_name ( keys %$cgi_params ) {
2439 if ( $param_name =~ /^tag_/ ) {
2440 my $param_value = $cgi_params->{$param_name};
2441 unless ( Encode::is_utf8( $param_value ) ) {
2442 $cgi_params->{$param_name} = Encode::decode('UTF-8', $param_value );
2447 # creating a new record
2448 my $record = MARC::Record->new();
2450 my ($biblionumbertagfield, $biblionumbertagsubfield) = (-1, -1);
2451 ($biblionumbertagfield, $biblionumbertagsubfield) =
2452 &GetMarcFromKohaField( "biblio.biblionumber", '' ) if $isbiblio;
2453 #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!
2454 for (my $i = 0; $params[$i]; $i++ ) { # browse all CGI params
2455 my $param = $params[$i];
2458 # if we are on biblionumber, store it in the MARC::Record (it may not be in the edited fields)
2459 if ( $param eq 'biblionumber' ) {
2460 if ( $biblionumbertagfield < 10 ) {
2461 $newfield = MARC::Field->new( $biblionumbertagfield, scalar $cgi->param($param), );
2463 $newfield = MARC::Field->new( $biblionumbertagfield, '', '', "$biblionumbertagsubfield" => scalar $cgi->param($param), );
2465 push @fields, $newfield if ($newfield);
2466 } elsif ( $param =~ /^tag_(\d*)_indicator1_/ ) { # new field start when having 'input name="..._indicator1_..."
2469 my $ind1 = _default_ind_to_space( substr( $cgi->param($param), 0, 1 ) );
2470 my $ind2 = _default_ind_to_space( substr( $cgi->param( $params[ $i + 1 ] ), 0, 1 ) );
2474 if ( $tag < 10 ) { # no code for theses fields
2475 # in MARC editor, 000 contains the leader.
2476 next if $tag == $biblionumbertagfield;
2477 my $fval= $cgi->param($params[$j+1]);
2478 if ( $tag eq '000' ) {
2479 # Force a fake leader even if not provided to avoid crashing
2480 # during decoding MARC record containing UTF-8 characters
2482 length( $fval ) == 24
2487 # between 001 and 009 (included)
2488 } elsif ( $fval ne '' ) {
2489 $newfield = MARC::Field->new( $tag, $fval, );
2492 # > 009, deal with subfields
2494 # browse subfields for this tag (reason for _code_ match)
2495 while(defined $params[$j] && $params[$j] =~ /_code_/) {
2496 last unless defined $params[$j+1];
2498 if $tag == $biblionumbertagfield and
2499 $cgi->param($params[$j]) eq $biblionumbertagsubfield;
2500 #if next param ne subfield, then it was probably empty
2501 #try next param by incrementing j
2502 if($params[$j+1]!~/_subfield_/) {$j++; next; }
2503 my $fkey= $cgi->param($params[$j]);
2504 my $fval= $cgi->param($params[$j+1]);
2505 #check if subfield value not empty and field exists
2506 if($fval ne '' && $newfield) {
2507 $newfield->add_subfields( $fkey => $fval);
2509 elsif($fval ne '') {
2510 $newfield = MARC::Field->new( $tag, $ind1, $ind2, $fkey => $fval );
2514 $i= $j-1; #update i for outer loop accordingly
2516 push @fields, $newfield if ($newfield);
2520 $record->append_fields(@fields);
2524 =head2 TransformMarcToKoha
2526 $result = TransformMarcToKoha( $record, $frameworkcode )
2528 Extract data from a MARC bib record into a hashref representing
2529 Koha biblio, biblioitems, and items fields.
2531 If passed an undefined record will log the error and return an empty
2536 sub TransformMarcToKoha {
2537 my ( $record, $frameworkcode, $limit_table ) = @_;
2540 if (!defined $record) {
2541 carp('TransformMarcToKoha called with undefined record');
2544 $limit_table = $limit_table || 0;
2545 $frameworkcode = '' unless defined $frameworkcode;
2547 my $inverted_field_map = _get_inverted_marc_field_map($frameworkcode);
2550 if ( defined $limit_table && $limit_table eq 'items' ) {
2551 $tables{'items'} = 1;
2553 $tables{'items'} = 1;
2554 $tables{'biblio'} = 1;
2555 $tables{'biblioitems'} = 1;
2558 # traverse through record
2559 MARCFIELD: foreach my $field ( $record->fields() ) {
2560 my $tag = $field->tag();
2561 next MARCFIELD unless exists $inverted_field_map->{$tag};
2562 if ( $field->is_control_field() ) {
2563 my $kohafields = $inverted_field_map->{$tag}->{list};
2564 ENTRY: foreach my $entry ( @{$kohafields} ) {
2565 my ( $subfield, $table, $column ) = @{$entry};
2566 next ENTRY unless exists $tables{$table};
2567 my $key = _disambiguate( $table, $column );
2568 if ( $result->{$key} ) {
2569 unless ( ( $key eq "biblionumber" or $key eq "biblioitemnumber" ) and ( $field->data() eq "" ) ) {
2570 $result->{$key} .= " | " . $field->data();
2573 $result->{$key} = $field->data();
2578 # deal with subfields
2579 MARCSUBFIELD: foreach my $sf ( $field->subfields() ) {
2580 my $code = $sf->[0];
2581 next MARCSUBFIELD unless exists $inverted_field_map->{$tag}->{sfs}->{$code};
2582 my $value = $sf->[1];
2583 SFENTRY: foreach my $entry ( @{ $inverted_field_map->{$tag}->{sfs}->{$code} } ) {
2584 my ( $table, $column ) = @{$entry};
2585 next SFENTRY unless exists $tables{$table};
2586 my $key = _disambiguate( $table, $column );
2587 if ( $result->{$key} ) {
2588 unless ( ( $key eq "biblionumber" or $key eq "biblioitemnumber" ) and ( $value eq "" ) ) {
2589 $result->{$key} .= " | " . $value;
2592 $result->{$key} = $value;
2599 # modify copyrightdate to keep only the 1st year found
2600 if ( exists $result->{'copyrightdate'} ) {
2601 my $temp = $result->{'copyrightdate'};
2602 $temp =~ m/c(\d\d\d\d)/;
2603 if ( $temp =~ m/c(\d\d\d\d)/ and $1 > 0 ) { # search cYYYY first
2604 $result->{'copyrightdate'} = $1;
2605 } else { # if no cYYYY, get the 1st date.
2606 $temp =~ m/(\d\d\d\d)/;
2607 $result->{'copyrightdate'} = $1;
2611 # modify publicationyear to keep only the 1st year found
2612 if ( exists $result->{'publicationyear'} ) {
2613 my $temp = $result->{'publicationyear'};
2614 if ( $temp =~ m/c(\d\d\d\d)/ and $1 > 0 ) { # search cYYYY first
2615 $result->{'publicationyear'} = $1;
2616 } else { # if no cYYYY, get the 1st date.
2617 $temp =~ m/(\d\d\d\d)/;
2618 $result->{'publicationyear'} = $1;
2625 sub _get_inverted_marc_field_map {
2626 my ( $frameworkcode ) = @_;
2628 my $mss = GetMarcSubfieldStructure( $frameworkcode );
2630 foreach my $kohafield ( keys %{ $mss } ) {
2631 next unless exists $mss->{$kohafield}; # not all columns are mapped to MARC tag & subfield
2632 my $tag = $mss->{$kohafield}{tagfield};
2633 my $subfield = $mss->{$kohafield}{tagsubfield};
2634 my ( $table, $column ) = split /[.]/, $kohafield, 2;
2635 push @{ $field_map->{$tag}->{list} }, [ $subfield, $table, $column ];
2636 push @{ $field_map->{$tag}->{sfs}->{$subfield} }, [ $table, $column ];
2641 =head2 _disambiguate
2643 $newkey = _disambiguate($table, $field);
2645 This is a temporary hack to distinguish between the
2646 following sets of columns when using TransformMarcToKoha.
2648 items.cn_source & biblioitems.cn_source
2649 items.cn_sort & biblioitems.cn_sort
2651 Columns that are currently NOT distinguished (FIXME
2652 due to lack of time to fully test) are:
2654 biblio.notes and biblioitems.notes
2659 FIXME - this is necessary because prefixing each column
2660 name with the table name would require changing lots
2661 of code and templates, and exposing more of the DB
2662 structure than is good to the UI templates, particularly
2663 since biblio and bibloitems may well merge in a future
2664 version. In the future, it would also be good to
2665 separate DB access and UI presentation field names
2670 sub CountItemsIssued {
2671 my ($biblionumber) = @_;
2672 my $dbh = C4::Context->dbh;
2673 my $sth = $dbh->prepare('SELECT COUNT(*) as issuedCount FROM items, issues WHERE items.itemnumber = issues.itemnumber AND items.biblionumber = ?');
2674 $sth->execute($biblionumber);
2675 my $row = $sth->fetchrow_hashref();
2676 return $row->{'issuedCount'};
2680 my ( $table, $column ) = @_;
2681 if ( $column eq "cn_sort" or $column eq "cn_source" ) {
2682 return $table . '.' . $column;
2689 =head2 get_koha_field_from_marc
2691 $result->{_disambiguate($table, $field)} =
2692 get_koha_field_from_marc($table,$field,$record,$frameworkcode);
2694 Internal function to map data from the MARC record to a specific non-MARC field.
2695 FIXME: this is meant to replace TransformMarcToKohaOneField after more testing.
2699 sub get_koha_field_from_marc {
2700 my ( $koha_table, $koha_column, $record, $frameworkcode ) = @_;
2701 my ( $tagfield, $subfield ) = GetMarcFromKohaField( $koha_table . '.' . $koha_column, $frameworkcode );
2703 foreach my $field ( $record->field($tagfield) ) {
2704 if ( $field->tag() < 10 ) {
2706 $kohafield .= " | " . $field->data();
2708 $kohafield = $field->data();
2711 if ( $field->subfields ) {
2712 my @subfields = $field->subfields();
2713 foreach my $subfieldcount ( 0 .. $#subfields ) {
2714 if ( $subfields[$subfieldcount][0] eq $subfield ) {
2716 $kohafield .= " | " . $subfields[$subfieldcount][1];
2718 $kohafield = $subfields[$subfieldcount][1];
2728 =head2 TransformMarcToKohaOneField
2730 $result = TransformMarcToKohaOneField( $kohatable, $kohafield, $record, $result, $frameworkcode )
2734 sub TransformMarcToKohaOneField {
2736 # FIXME ? if a field has a repeatable subfield that is used in old-db,
2737 # only the 1st will be retrieved...
2738 my ( $kohatable, $kohafield, $record, $result, $frameworkcode ) = @_;
2740 my ( $tagfield, $subfield ) = GetMarcFromKohaField( $kohatable . "." . $kohafield, $frameworkcode );
2741 foreach my $field ( $record->field($tagfield) ) {
2742 if ( $field->tag() < 10 ) {
2743 if ( $result->{$kohafield} ) {
2744 $result->{$kohafield} .= " | " . $field->data();
2746 $result->{$kohafield} = $field->data();
2749 if ( $field->subfields ) {
2750 my @subfields = $field->subfields();
2751 foreach my $subfieldcount ( 0 .. $#subfields ) {
2752 if ( $subfields[$subfieldcount][0] eq $subfield ) {
2753 if ( $result->{$kohafield} ) {
2754 $result->{$kohafield} .= " | " . $subfields[$subfieldcount][1];
2756 $result->{$kohafield} = $subfields[$subfieldcount][1];
2770 # true ModZebra commented until indexdata fixes zebraDB crashes (it seems they occur on multiple updates
2772 # replaced by a zebraqueue table, that is filled with ModZebra to run.
2773 # the table is emptied by misc/cronjobs/zebraqueue_start.pl script
2774 # =head2 ModZebrafiles
2776 # &ModZebrafiles( $dbh, $biblionumber, $record, $folder, $server );
2780 # sub ModZebrafiles {
2782 # my ( $dbh, $biblionumber, $record, $folder, $server ) = @_;
2786 # C4::Context->zebraconfig($server)->{directory} . "/" . $folder . "/";
2787 # unless ( opendir( DIR, "$zebradir" ) ) {
2788 # warn "$zebradir not found";
2792 # my $filename = $zebradir . $biblionumber;
2795 # open( OUTPUT, ">", $filename . ".xml" );
2796 # print OUTPUT $record;
2803 ModZebra( $biblionumber, $op, $server, $record );
2805 $biblionumber is the biblionumber we want to index
2807 $op is specialUpdate or recordDelete, and is used to know what we want to do
2809 $server is the server that we want to update
2811 $record is the update MARC record if it's available. If it's not supplied
2812 and is needed, it'll be loaded from the database.
2817 ###Accepts a $server variable thus we can use it for biblios authorities or other zebra dbs
2818 my ( $biblionumber, $op, $server, $record ) = @_;
2819 $debug && warn "ModZebra: update requested for: $biblionumber $op $server\n";
2820 if ( C4::Context->preference('SearchEngine') eq 'Elasticsearch' ) {
2822 # TODO abstract to a standard API that'll work for whatever
2823 require Koha::SearchEngine::Elasticsearch::Indexer;
2824 my $indexer = Koha::SearchEngine::Elasticsearch::Indexer->new(
2826 index => $server eq 'biblioserver'
2827 ? $Koha::SearchEngine::BIBLIOS_INDEX
2828 : $Koha::SearchEngine::AUTHORITIES_INDEX
2831 if ( $op eq 'specialUpdate' ) {
2833 $record = GetMarcBiblio($biblionumber, 1);
2835 my $records = [$record];
2836 $indexer->update_index_background( [$biblionumber], [$record] );
2838 elsif ( $op eq 'recordDelete' ) {
2839 $indexer->delete_index_background( [$biblionumber] );
2842 croak "ModZebra called with unknown operation: $op";
2846 my $dbh = C4::Context->dbh;
2848 # true ModZebra commented until indexdata fixes zebraDB crashes (it seems they occur on multiple updates
2850 # replaced by a zebraqueue table, that is filled with ModZebra to run.
2851 # the table is emptied by rebuild_zebra.pl script (using the -z switch)
2852 my $check_sql = "SELECT COUNT(*) FROM zebraqueue
2854 AND biblio_auth_number = ?
2857 my $check_sth = $dbh->prepare_cached($check_sql);
2858 $check_sth->execute( $server, $biblionumber, $op );
2859 my ($count) = $check_sth->fetchrow_array;
2860 $check_sth->finish();
2861 if ( $count == 0 ) {
2862 my $sth = $dbh->prepare("INSERT INTO zebraqueue (biblio_auth_number,server,operation) VALUES(?,?,?)");
2863 $sth->execute( $biblionumber, $server, $op );
2869 =head2 EmbedItemsInMarcBiblio
2871 EmbedItemsInMarcBiblio($marc, $biblionumber, $itemnumbers, $opac);
2873 Given a MARC::Record object containing a bib record,
2874 modify it to include the items attached to it as 9XX
2875 per the bib's MARC framework.
2876 if $itemnumbers is defined, only specified itemnumbers are embedded.
2878 If $opac is true, then opac-relevant suppressions are included.
2882 sub EmbedItemsInMarcBiblio {
2883 my ($marc, $biblionumber, $itemnumbers, $opac) = @_;
2885 carp 'EmbedItemsInMarcBiblio: No MARC record passed';
2889 $itemnumbers = [] unless defined $itemnumbers;
2891 my $frameworkcode = GetFrameworkCode($biblionumber);
2892 _strip_item_fields($marc, $frameworkcode);
2894 # ... and embed the current items
2895 my $dbh = C4::Context->dbh;
2896 my $sth = $dbh->prepare("SELECT itemnumber FROM items WHERE biblionumber = ?");
2897 $sth->execute($biblionumber);
2899 my ( $itemtag, $itemsubfield ) = GetMarcFromKohaField( "items.itemnumber", $frameworkcode );
2901 my $opachiddenitems = $opac
2902 && ( C4::Context->preference('OpacHiddenItems') !~ /^\s*$/ );
2904 while ( my ($itemnumber) = $sth->fetchrow_array ) {
2905 next if @$itemnumbers and not grep { $_ == $itemnumber } @$itemnumbers;
2906 my $i = $opachiddenitems ? C4::Items::GetItem($itemnumber) : undef;
2907 push @items, { itemnumber => $itemnumber, item => $i };
2911 ? C4::Items::GetHiddenItemnumbers( map { $_->{item} } @items )
2913 # Convert to a hash for quick searching
2914 my %hiddenitems = map { $_ => 1 } @hiddenitems;
2915 foreach my $itemnumber ( map { $_->{itemnumber} } @items ) {
2916 next if $hiddenitems{$itemnumber};
2917 my $item_marc = C4::Items::GetMarcItem( $biblionumber, $itemnumber );
2918 push @item_fields, $item_marc->field($itemtag);
2920 $marc->append_fields(@item_fields);
2923 =head1 INTERNAL FUNCTIONS
2925 =head2 _koha_marc_update_bib_ids
2928 _koha_marc_update_bib_ids($record, $frameworkcode, $biblionumber, $biblioitemnumber);
2930 Internal function to add or update biblionumber and biblioitemnumber to
2935 sub _koha_marc_update_bib_ids {
2936 my ( $record, $frameworkcode, $biblionumber, $biblioitemnumber ) = @_;
2938 my ( $biblio_tag, $biblio_subfield ) = GetMarcFromKohaField( "biblio.biblionumber", $frameworkcode );
2939 die qq{No biblionumber tag for framework "$frameworkcode"} unless $biblio_tag;
2940 my ( $biblioitem_tag, $biblioitem_subfield ) = GetMarcFromKohaField( "biblioitems.biblioitemnumber", $frameworkcode );
2941 die qq{No biblioitemnumber tag for framework "$frameworkcode"} unless $biblioitem_tag;
2943 if ( $biblio_tag < 10 ) {
2944 C4::Biblio::UpsertMarcControlField( $record, $biblio_tag, $biblionumber );
2946 C4::Biblio::UpsertMarcSubfield($record, $biblio_tag, $biblio_subfield, $biblionumber);
2948 if ( $biblioitem_tag < 10 ) {
2949 C4::Biblio::UpsertMarcControlField( $record, $biblioitem_tag, $biblioitemnumber );
2951 C4::Biblio::UpsertMarcSubfield($record, $biblioitem_tag, $biblioitem_subfield, $biblioitemnumber);
2955 =head2 _koha_marc_update_biblioitem_cn_sort
2957 _koha_marc_update_biblioitem_cn_sort($marc, $biblioitem, $frameworkcode);
2959 Given a MARC bib record and the biblioitem hash, update the
2960 subfield that contains a copy of the value of biblioitems.cn_sort.
2964 sub _koha_marc_update_biblioitem_cn_sort {
2966 my $biblioitem = shift;
2967 my $frameworkcode = shift;
2969 my ( $biblioitem_tag, $biblioitem_subfield ) = GetMarcFromKohaField( "biblioitems.cn_sort", $frameworkcode );
2970 return unless $biblioitem_tag;
2972 my ($cn_sort) = GetClassSort( $biblioitem->{'biblioitems.cn_source'}, $biblioitem->{'cn_class'}, $biblioitem->{'cn_item'} );
2974 if ( my $field = $marc->field($biblioitem_tag) ) {
2975 $field->delete_subfield( code => $biblioitem_subfield );
2976 if ( $cn_sort ne '' ) {
2977 $field->add_subfields( $biblioitem_subfield => $cn_sort );
2981 # if we get here, no biblioitem tag is present in the MARC record, so
2982 # we'll create it if $cn_sort is not empty -- this would be
2983 # an odd combination of events, however
2985 $marc->insert_grouped_field( MARC::Field->new( $biblioitem_tag, ' ', ' ', $biblioitem_subfield => $cn_sort ) );
2990 =head2 _koha_add_biblio
2992 my ($biblionumber,$error) = _koha_add_biblio($dbh,$biblioitem);
2994 Internal function to add a biblio ($biblio is a hash with the values)
2998 sub _koha_add_biblio {
2999 my ( $dbh, $biblio, $frameworkcode ) = @_;
3003 # set the series flag
3004 unless (defined $biblio->{'serial'}){
3005 $biblio->{'serial'} = 0;
3006 if ( $biblio->{'seriestitle'} ) { $biblio->{'serial'} = 1 }
3009 my $query = "INSERT INTO biblio
3010 SET frameworkcode = ?,
3021 my $sth = $dbh->prepare($query);
3023 $frameworkcode, $biblio->{'author'}, $biblio->{'title'}, $biblio->{'unititle'}, $biblio->{'notes'},
3024 $biblio->{'serial'}, $biblio->{'seriestitle'}, $biblio->{'copyrightdate'}, $biblio->{'abstract'}
3027 my $biblionumber = $dbh->{'mysql_insertid'};
3028 if ( $dbh->errstr ) {
3029 $error .= "ERROR in _koha_add_biblio $query" . $dbh->errstr;
3035 #warn "LEAVING _koha_add_biblio: ".$biblionumber."\n";
3036 return ( $biblionumber, $error );
3039 =head2 _koha_modify_biblio
3041 my ($biblionumber,$error) == _koha_modify_biblio($dbh,$biblio,$frameworkcode);
3043 Internal function for updating the biblio table
3047 sub _koha_modify_biblio {
3048 my ( $dbh, $biblio, $frameworkcode ) = @_;
3053 SET frameworkcode = ?,
3062 WHERE biblionumber = ?
3065 my $sth = $dbh->prepare($query);
3068 $frameworkcode, $biblio->{'author'}, $biblio->{'title'}, $biblio->{'unititle'}, $biblio->{'notes'},
3069 $biblio->{'serial'}, $biblio->{'seriestitle'}, $biblio->{'copyrightdate'}, $biblio->{'abstract'}, $biblio->{'biblionumber'}
3070 ) if $biblio->{'biblionumber'};
3072 if ( $dbh->errstr || !$biblio->{'biblionumber'} ) {
3073 $error .= "ERROR in _koha_modify_biblio $query" . $dbh->errstr;
3076 return ( $biblio->{'biblionumber'}, $error );
3079 =head2 _koha_modify_biblioitem_nonmarc
3081 my ($biblioitemnumber,$error) = _koha_modify_biblioitem_nonmarc( $dbh, $biblioitem );
3085 sub _koha_modify_biblioitem_nonmarc {
3086 my ( $dbh, $biblioitem ) = @_;
3089 # re-calculate the cn_sort, it may have changed
3090 my ($cn_sort) = GetClassSort( $biblioitem->{'biblioitems.cn_source'}, $biblioitem->{'cn_class'}, $biblioitem->{'cn_item'} );
3092 my $query = "UPDATE biblioitems
3093 SET biblionumber = ?,
3099 publicationyear = ?,
3103 collectiontitle = ?,
3105 collectionvolume= ?,
3106 editionstatement= ?,
3107 editionresponsibility = ?,
3123 where biblioitemnumber = ?
3125 my $sth = $dbh->prepare($query);
3127 $biblioitem->{'biblionumber'}, $biblioitem->{'volume'}, $biblioitem->{'number'}, $biblioitem->{'itemtype'},
3128 $biblioitem->{'isbn'}, $biblioitem->{'issn'}, $biblioitem->{'publicationyear'}, $biblioitem->{'publishercode'},
3129 $biblioitem->{'volumedate'}, $biblioitem->{'volumedesc'}, $biblioitem->{'collectiontitle'}, $biblioitem->{'collectionissn'},
3130 $biblioitem->{'collectionvolume'}, $biblioitem->{'editionstatement'}, $biblioitem->{'editionresponsibility'}, $biblioitem->{'illus'},
3131 $biblioitem->{'pages'}, $biblioitem->{'bnotes'}, $biblioitem->{'size'}, $biblioitem->{'place'},
3132 $biblioitem->{'lccn'}, $biblioitem->{'url'}, $biblioitem->{'biblioitems.cn_source'}, $biblioitem->{'cn_class'},
3133 $biblioitem->{'cn_item'}, $biblioitem->{'cn_suffix'}, $cn_sort, $biblioitem->{'totalissues'},
3134 $biblioitem->{'ean'}, $biblioitem->{'agerestriction'}, $biblioitem->{'biblioitemnumber'}
3136 if ( $dbh->errstr ) {
3137 $error .= "ERROR in _koha_modify_biblioitem_nonmarc $query" . $dbh->errstr;
3140 return ( $biblioitem->{'biblioitemnumber'}, $error );
3143 =head2 _koha_add_biblioitem
3145 my ($biblioitemnumber,$error) = _koha_add_biblioitem( $dbh, $biblioitem );
3147 Internal function to add a biblioitem
3151 sub _koha_add_biblioitem {
3152 my ( $dbh, $biblioitem ) = @_;
3155 my ($cn_sort) = GetClassSort( $biblioitem->{'biblioitems.cn_source'}, $biblioitem->{'cn_class'}, $biblioitem->{'cn_item'} );
3156 my $query = "INSERT INTO biblioitems SET
3163 publicationyear = ?,
3167 collectiontitle = ?,
3169 collectionvolume= ?,
3170 editionstatement= ?,
3171 editionresponsibility = ?,
3188 my $sth = $dbh->prepare($query);
3190 $biblioitem->{'biblionumber'}, $biblioitem->{'volume'}, $biblioitem->{'number'}, $biblioitem->{'itemtype'},
3191 $biblioitem->{'isbn'}, $biblioitem->{'issn'}, $biblioitem->{'publicationyear'}, $biblioitem->{'publishercode'},
3192 $biblioitem->{'volumedate'}, $biblioitem->{'volumedesc'}, $biblioitem->{'collectiontitle'}, $biblioitem->{'collectionissn'},
3193 $biblioitem->{'collectionvolume'}, $biblioitem->{'editionstatement'}, $biblioitem->{'editionresponsibility'}, $biblioitem->{'illus'},
3194 $biblioitem->{'pages'}, $biblioitem->{'bnotes'}, $biblioitem->{'size'}, $biblioitem->{'place'},
3195 $biblioitem->{'lccn'}, $biblioitem->{'url'}, $biblioitem->{'biblioitems.cn_source'},
3196 $biblioitem->{'cn_class'}, $biblioitem->{'cn_item'}, $biblioitem->{'cn_suffix'}, $cn_sort,
3197 $biblioitem->{'totalissues'}, $biblioitem->{'ean'}, $biblioitem->{'agerestriction'}
3199 my $bibitemnum = $dbh->{'mysql_insertid'};
3201 if ( $dbh->errstr ) {
3202 $error .= "ERROR in _koha_add_biblioitem $query" . $dbh->errstr;
3206 return ( $bibitemnum, $error );
3209 =head2 _koha_delete_biblio
3211 $error = _koha_delete_biblio($dbh,$biblionumber);
3213 Internal sub for deleting from biblio table -- also saves to deletedbiblio
3215 C<$dbh> - the database handle
3217 C<$biblionumber> - the biblionumber of the biblio to be deleted
3221 # FIXME: add error handling
3223 sub _koha_delete_biblio {
3224 my ( $dbh, $biblionumber ) = @_;
3226 # get all the data for this biblio
3227 my $sth = $dbh->prepare("SELECT * FROM biblio WHERE biblionumber=?");
3228 $sth->execute($biblionumber);
3230 # FIXME There is a transaction in _koha_delete_biblio_metadata
3231 # But actually all the following should be done inside a single transaction
3232 if ( my $data = $sth->fetchrow_hashref ) {
3234 # save the record in deletedbiblio
3235 # find the fields to save
3236 my $query = "INSERT INTO deletedbiblio SET ";
3238 foreach my $temp ( keys %$data ) {
3239 $query .= "$temp = ?,";
3240 push( @bind, $data->{$temp} );
3243 # replace the last , by ",?)"
3245 my $bkup_sth = $dbh->prepare($query);
3246 $bkup_sth->execute(@bind);
3249 _koha_delete_biblio_metadata( $biblionumber );
3252 my $sth2 = $dbh->prepare("DELETE FROM biblio WHERE biblionumber=?");
3253 $sth2->execute($biblionumber);
3254 # update the timestamp (Bugzilla 7146)
3255 $sth2= $dbh->prepare("UPDATE deletedbiblio SET timestamp=NOW() WHERE biblionumber=?");
3256 $sth2->execute($biblionumber);
3263 =head2 _koha_delete_biblioitems
3265 $error = _koha_delete_biblioitems($dbh,$biblioitemnumber);
3267 Internal sub for deleting from biblioitems table -- also saves to deletedbiblioitems
3269 C<$dbh> - the database handle
3270 C<$biblionumber> - the biblioitemnumber of the biblioitem to be deleted
3274 # FIXME: add error handling
3276 sub _koha_delete_biblioitems {
3277 my ( $dbh, $biblioitemnumber ) = @_;
3279 # get all the data for this biblioitem
3280 my $sth = $dbh->prepare("SELECT * FROM biblioitems WHERE biblioitemnumber=?");
3281 $sth->execute($biblioitemnumber);
3283 if ( my $data = $sth->fetchrow_hashref ) {
3285 # save the record in deletedbiblioitems
3286 # find the fields to save
3287 my $query = "INSERT INTO deletedbiblioitems SET ";
3289 foreach my $temp ( keys %$data ) {
3290 $query .= "$temp = ?,";
3291 push( @bind, $data->{$temp} );
3294 # replace the last , by ",?)"
3296 my $bkup_sth = $dbh->prepare($query);
3297 $bkup_sth->execute(@bind);
3300 # delete the biblioitem
3301 my $sth2 = $dbh->prepare("DELETE FROM biblioitems WHERE biblioitemnumber=?");
3302 $sth2->execute($biblioitemnumber);
3303 # update the timestamp (Bugzilla 7146)
3304 $sth2= $dbh->prepare("UPDATE deletedbiblioitems SET timestamp=NOW() WHERE biblioitemnumber=?");
3305 $sth2->execute($biblioitemnumber);
3312 =head2 _koha_delete_biblio_metadata
3314 $error = _koha_delete_biblio_metadata($biblionumber);
3316 C<$biblionumber> - the biblionumber of the biblio metadata to be deleted
3320 sub _koha_delete_biblio_metadata {
3321 my ($biblionumber) = @_;
3323 my $dbh = C4::Context->dbh;
3324 my $schema = Koha::Database->new->schema;
3328 INSERT INTO deletedbiblio_metadata (biblionumber, format, marcflavour, metadata)
3329 SELECT biblionumber, format, marcflavour, metadata FROM biblio_metadata WHERE biblionumber=?
3330 |, undef, $biblionumber );
3331 $dbh->do( q|DELETE FROM biblio_metadata WHERE biblionumber=?|,
3332 undef, $biblionumber );
3337 =head1 UNEXPORTED FUNCTIONS
3339 =head2 ModBiblioMarc
3341 &ModBiblioMarc($newrec,$biblionumber,$frameworkcode);
3343 Add MARC XML data for a biblio to koha
3345 Function exported, but should NOT be used, unless you really know what you're doing
3350 # pass the MARC::Record to this function, and it will create the records in
3352 my ( $record, $biblionumber, $frameworkcode ) = @_;
3354 carp 'ModBiblioMarc passed an undefined record';
3358 # Clone record as it gets modified
3359 $record = $record->clone();
3360 my $dbh = C4::Context->dbh;
3361 my @fields = $record->fields();
3362 if ( !$frameworkcode ) {
3363 $frameworkcode = "";
3365 my $sth = $dbh->prepare("UPDATE biblio SET frameworkcode=? WHERE biblionumber=?");
3366 $sth->execute( $frameworkcode, $biblionumber );
3368 my $encoding = C4::Context->preference("marcflavour");
3370 # deal with UNIMARC field 100 (encoding) : create it if needed & set encoding to unicode
3371 if ( $encoding eq "UNIMARC" ) {
3372 my $defaultlanguage = C4::Context->preference("UNIMARCField100Language");
3373 $defaultlanguage = "fre" if (!$defaultlanguage || length($defaultlanguage) != 3);
3374 my $string = $record->subfield( 100, "a" );
3375 if ( ($string) && ( length( $record->subfield( 100, "a" ) ) == 36 ) ) {
3376 my $f100 = $record->field(100);
3377 $record->delete_field($f100);
3379 $string = POSIX::strftime( "%Y%m%d", localtime );
3381 $string = sprintf( "%-*s", 35, $string );
3382 substr ( $string, 22, 3, $defaultlanguage);
3384 substr( $string, 25, 3, "y50" );
3385 unless ( $record->subfield( 100, "a" ) ) {
3386 $record->insert_fields_ordered( MARC::Field->new( 100, "", "", "a" => $string ) );
3390 #enhancement 5374: update transaction date (005) for marc21/unimarc
3391 if($encoding =~ /MARC21|UNIMARC/) {
3392 my @a= (localtime) [5,4,3,2,1,0]; $a[0]+=1900; $a[1]++;
3393 # YY MM DD HH MM SS (update year and month)
3394 my $f005= $record->field('005');
3395 $f005->update(sprintf("%4d%02d%02d%02d%02d%04.1f",@a)) if $f005;
3399 biblionumber => $biblionumber,
3400 format => 'marcxml',
3401 marcflavour => C4::Context->preference('marcflavour'),
3403 # FIXME To replace with ->find_or_create?
3404 if ( my $m_rs = Koha::Biblio::Metadatas->find($metadata) ) {
3405 $m_rs->metadata( $record->as_xml_record($encoding) );
3408 my $m_rs = Koha::Biblio::Metadata->new($metadata);
3409 $m_rs->metadata( $record->as_xml_record($encoding) );
3412 ModZebra( $biblionumber, "specialUpdate", "biblioserver", $record );
3413 return $biblionumber;
3416 =head2 CountBiblioInOrders
3418 $count = &CountBiblioInOrders( $biblionumber);
3420 This function return count of biblios in orders with $biblionumber
3424 sub CountBiblioInOrders {
3425 my ($biblionumber) = @_;
3426 my $dbh = C4::Context->dbh;
3427 my $query = "SELECT count(*)
3429 WHERE biblionumber=? AND (datecancellationprinted IS NULL OR datecancellationprinted='0000-00-00')";
3430 my $sth = $dbh->prepare($query);
3431 $sth->execute($biblionumber);
3432 my $count = $sth->fetchrow;
3436 =head2 prepare_host_field
3438 $marcfield = prepare_host_field( $hostbiblioitem, $marcflavour );
3439 Generate the host item entry for an analytic child entry
3443 sub prepare_host_field {
3444 my ( $hostbiblio, $marcflavour ) = @_;
3445 $marcflavour ||= C4::Context->preference('marcflavour');
3446 my $host = GetMarcBiblio($hostbiblio);
3447 # unfortunately as_string does not 'do the right thing'
3448 # if field returns undef
3452 if ( $marcflavour eq 'MARC21' || $marcflavour eq 'NORMARC' ) {
3453 if ( $field = $host->field('100') || $host->field('110') || $host->field('11') ) {
3454 my $s = $field->as_string('ab');
3459 if ( $field = $host->field('245') ) {
3460 my $s = $field->as_string('a');
3465 if ( $field = $host->field('260') ) {
3466 my $s = $field->as_string('abc');
3471 if ( $field = $host->field('240') ) {
3472 my $s = $field->as_string();
3477 if ( $field = $host->field('022') ) {
3478 my $s = $field->as_string('a');
3483 if ( $field = $host->field('020') ) {
3484 my $s = $field->as_string('a');
3489 if ( $field = $host->field('001') ) {
3490 $sfd{w} = $field->data(),;
3492 $host_field = MARC::Field->new( 773, '0', ' ', %sfd );
3495 elsif ( $marcflavour eq 'UNIMARC' ) {
3497 if ( $field = $host->field('700') || $host->field('710') || $host->field('720') ) {
3498 my $s = $field->as_string('ab');
3504 if ( $field = $host->field('200') ) {
3505 my $s = $field->as_string('a');
3510 #place of publicaton
3511 if ( $field = $host->field('210') ) {
3512 my $s = $field->as_string('a');
3517 #date of publication
3518 if ( $field = $host->field('210') ) {
3519 my $s = $field->as_string('d');
3525 if ( $field = $host->field('205') ) {
3526 my $s = $field->as_string();
3532 if ( $field = $host->field('856') ) {
3533 my $s = $field->as_string('u');
3539 if ( $field = $host->field('011') ) {
3540 my $s = $field->as_string('a');
3546 if ( $field = $host->field('010') ) {
3547 my $s = $field->as_string('a');
3552 if ( $field = $host->field('001') ) {
3553 $sfd{0} = $field->data(),;
3555 $host_field = MARC::Field->new( 461, '0', ' ', %sfd );
3562 =head2 UpdateTotalIssues
3564 UpdateTotalIssues($biblionumber, $increase, [$value])
3566 Update the total issue count for a particular bib record.
3570 =item C<$biblionumber> is the biblionumber of the bib to update
3572 =item C<$increase> is the amount to increase (or decrease) the total issues count by
3574 =item C<$value> is the absolute value that total issues count should be set to. If provided, C<$increase> is ignored.
3580 sub UpdateTotalIssues {
3581 my ($biblionumber, $increase, $value) = @_;
3584 my $record = GetMarcBiblio($biblionumber);
3586 carp "UpdateTotalIssues could not get biblio record";
3589 my $biblio = Koha::Biblios->find( $biblionumber );
3591 carp "UpdateTotalIssues could not get datas of biblio";
3594 my $biblioitem = $biblio->biblioitem;
3595 my ($totalissuestag, $totalissuessubfield) = GetMarcFromKohaField('biblioitems.totalissues', $biblio->frameworkcode);
3596 unless ($totalissuestag) {
3597 return 1; # There is nothing to do
3600 if (defined $value) {
3601 $totalissues = $value;
3603 $totalissues = $biblioitem->totalissues + $increase;
3606 my $field = $record->field($totalissuestag);
3607 if (defined $field) {
3608 $field->update( $totalissuessubfield => $totalissues );
3610 $field = MARC::Field->new($totalissuestag, '0', '0',
3611 $totalissuessubfield => $totalissues);
3612 $record->insert_grouped_field($field);
3615 return ModBiblio($record, $biblionumber, $biblio->frameworkcode);
3620 &RemoveAllNsb($record);
3622 Removes all nsb/nse chars from a record
3629 carp 'RemoveAllNsb called with undefined record';
3633 SetUTF8Flag($record);
3635 foreach my $field ($record->fields()) {
3636 if ($field->is_control_field()) {
3637 $field->update(nsb_clean($field->data()));
3639 my @subfields = $field->subfields();
3641 foreach my $subfield (@subfields) {
3642 push @new_subfields, $subfield->[0] => nsb_clean($subfield->[1]);
3644 if (scalar(@new_subfields) > 0) {
3647 $new_field = MARC::Field->new(
3649 $field->indicator(1),
3650 $field->indicator(2),
3655 warn "error in RemoveAllNsb : $@";
3657 $field->replace_with($new_field);
3673 Koha Development Team <http://koha-community.org/>
3675 Paul POULAIN paul.poulain@free.fr
3677 Joshua Ferraro jmf@liblime.com