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>.
24 use vars
qw(@ISA @EXPORT);
50 GetAuthorisedValueDesc
52 IsMarcStructureInternal
54 GetMarcSubfieldStructureFromKohaField
66 LinkBibHeadingsToAuthorities
74 # those functions are exported but should not be used
75 # they are useful in a few circumstances, so they are exported,
76 # but don't use them unless you are a core developer ;-)
84 use Encode
qw( decode is_utf8 );
85 use List
::MoreUtils
qw( uniq );
87 use MARC
::File
::USMARC
;
89 use POSIX
qw(strftime);
90 use Module
::Load
::Conditional
qw(can_load);
93 use C4
::Log
; # logaction
102 use Koha
::Authority
::Types
;
103 use Koha
::Acquisition
::Currencies
;
104 use Koha
::Biblio
::Metadatas
;
107 use Koha
::SearchEngine
;
109 use Koha
::Util
::MARC
;
111 use vars
qw($debug $cgi_debug);
116 C4::Biblio - cataloging management functions
120 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:
124 =item 1. in the biblio,biblioitems,items, etc tables, which are limited to a one-to-one mapping to underlying MARC data
126 =item 2. as raw MARC in the Zebra index and storage engine
128 =item 3. as MARC XML in biblio_metadata.metadata
132 In the 3.0 version of Koha, the authoritative record-level information is in biblio_metadata.metadata
134 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.
138 =item 1. Compared with MySQL, Zebra is slow to update an index for small data changes -- especially for proc-intensive operations like circulation
140 =item 2. Zebra's index has been known to crash and a backup of the data is necessary to rebuild it in such cases
144 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:
148 =item 1. Add*/Mod*/Del*/ - high-level external functions suitable for being called from external scripts to manage the collection
150 =item 2. _koha_* - low-level internal functions for managing the koha tables
152 =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.
154 =item 4. Zebra functions used to update the Zebra index
156 =item 5. internal helper functions such as char_decode, checkitems, etc. Some of these probably belong in Koha.pm
160 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 :
164 =item 1. save datas in biblio and biblioitems table, that gives us a biblionumber and a biblioitemnumber
166 =item 2. add the biblionumber and biblioitemnumber into the MARC records
168 =item 3. save the marc record
172 =head1 EXPORTED FUNCTIONS
176 ($biblionumber,$biblioitemnumber) = AddBiblio($record,$frameworkcode);
178 Exported function (core API) for adding a new biblio to koha.
180 The first argument is a C<MARC::Record> object containing the
181 bib to add, while the second argument is the desired MARC
184 This function also accepts a third, optional argument: a hashref
185 to additional options. The only defined option is C<defer_marc_save>,
186 which if present and mapped to a true value, causes C<AddBiblio>
187 to omit the call to save the MARC in C<biblio_metadata.metadata>
188 This option is provided B<only>
189 for the use of scripts such as C<bulkmarcimport.pl> that may need
190 to do some manipulation of the MARC record for item parsing before
191 saving it and which cannot afford the performance hit of saving
192 the MARC record twice. Consequently, do not use that option
193 unless you can guarantee that C<ModBiblioMarc> will be called.
199 my $frameworkcode = shift;
200 my $options = @_ ? shift : undef;
201 my $defer_marc_save = 0;
203 carp('AddBiblio called with undefined record');
206 if ( defined $options and exists $options->{'defer_marc_save'} and $options->{'defer_marc_save'} ) {
207 $defer_marc_save = 1;
210 if (C4::Context->preference('BiblioAddsAuthorities')) {
211 BiblioAutoLink( $record, $frameworkcode );
214 my ( $biblionumber, $biblioitemnumber, $error );
215 my $dbh = C4::Context->dbh;
217 # transform the data into koha-table style data
218 SetUTF8Flag($record);
219 my $olddata = TransformMarcToKoha( $record, $frameworkcode );
220 ( $biblionumber, $error ) = _koha_add_biblio( $dbh, $olddata, $frameworkcode );
221 $olddata->{'biblionumber'} = $biblionumber;
222 ( $biblioitemnumber, $error ) = _koha_add_biblioitem( $dbh, $olddata );
224 _koha_marc_update_bib_ids( $record, $frameworkcode, $biblionumber, $biblioitemnumber );
226 # update MARC subfield that stores biblioitems.cn_sort
227 _koha_marc_update_biblioitem_cn_sort( $record, $olddata, $frameworkcode );
230 ModBiblioMarc( $record, $biblionumber, $frameworkcode ) unless $defer_marc_save;
232 # update OAI-PMH sets
233 if(C4::Context->preference("OAI-PMH:AutoUpdateSets")) {
234 C4::OAI::Sets::UpdateOAISetsBiblio($biblionumber, $record);
237 logaction( "CATALOGUING", "ADD", $biblionumber, "biblio" ) if C4::Context->preference("CataloguingLog");
238 return ( $biblionumber, $biblioitemnumber );
243 ModBiblio( $record,$biblionumber,$frameworkcode, $disable_autolink);
245 Replace an existing bib record identified by C<$biblionumber>
246 with one supplied by the MARC::Record object C<$record>. The embedded
247 item, biblioitem, and biblionumber fields from the previous
248 version of the bib record replace any such fields of those tags that
249 are present in C<$record>. Consequently, ModBiblio() is not
250 to be used to try to modify item records.
252 C<$frameworkcode> specifies the MARC framework to use
253 when storing the modified bib record; among other things,
254 this controls how MARC fields get mapped to display columns
255 in the C<biblio> and C<biblioitems> tables, as well as
256 which fields are used to store embedded item, biblioitem,
257 and biblionumber data for indexing.
259 Unless C<$disable_autolink> is passed ModBiblio will relink record headings
260 to authorities based on settings in the system preferences. This flag allows
261 us to not relink records when the authority linker is saving modifications.
263 Returns 1 on success 0 on failure
268 my ( $record, $biblionumber, $frameworkcode, $disable_autolink ) = @_;
270 carp 'No record passed to ModBiblio';
274 if ( C4::Context->preference("CataloguingLog") ) {
275 my $newrecord = GetMarcBiblio({ biblionumber => $biblionumber });
276 logaction( "CATALOGUING", "MODIFY", $biblionumber, "biblio BEFORE=>" . $newrecord->as_formatted );
279 if ( !$disable_autolink && C4::Context->preference('BiblioAddsAuthorities') ) {
280 BiblioAutoLink( $record, $frameworkcode );
283 # Cleaning up invalid fields must be done early or SetUTF8Flag is liable to
284 # throw an exception which probably won't be handled.
285 foreach my $field ($record->fields()) {
286 if (! $field->is_control_field()) {
287 if (scalar($field->subfields()) == 0 || (scalar($field->subfields()) == 1 && $field->subfield('9'))) {
288 $record->delete_field($field);
293 SetUTF8Flag($record);
294 my $dbh = C4::Context->dbh;
296 $frameworkcode = "" if !$frameworkcode || $frameworkcode eq "Default"; # XXX
298 _strip_item_fields($record, $frameworkcode);
300 # update biblionumber and biblioitemnumber in MARC
301 # FIXME - this is assuming a 1 to 1 relationship between
302 # biblios and biblioitems
303 my $sth = $dbh->prepare("select biblioitemnumber from biblioitems where biblionumber=?");
304 $sth->execute($biblionumber);
305 my ($biblioitemnumber) = $sth->fetchrow;
307 _koha_marc_update_bib_ids( $record, $frameworkcode, $biblionumber, $biblioitemnumber );
309 # load the koha-table data object
310 my $oldbiblio = TransformMarcToKoha( $record, $frameworkcode );
312 # update MARC subfield that stores biblioitems.cn_sort
313 _koha_marc_update_biblioitem_cn_sort( $record, $oldbiblio, $frameworkcode );
315 # update the MARC record (that now contains biblio and items) with the new record data
316 &ModBiblioMarc( $record, $biblionumber, $frameworkcode );
318 # modify the other koha tables
319 _koha_modify_biblio( $dbh, $oldbiblio, $frameworkcode );
320 _koha_modify_biblioitem_nonmarc( $dbh, $oldbiblio );
322 # update OAI-PMH sets
323 if(C4::Context->preference("OAI-PMH:AutoUpdateSets")) {
324 C4::OAI::Sets::UpdateOAISetsBiblio($biblionumber, $record);
330 =head2 _strip_item_fields
332 _strip_item_fields($record, $frameworkcode)
334 Utility routine to remove item tags from a
339 sub _strip_item_fields {
341 my $frameworkcode = shift;
342 # get the items before and append them to the biblio before updating the record, atm we just have the biblio
343 my ( $itemtag, $itemsubfield ) = GetMarcFromKohaField( "items.itemnumber", $frameworkcode );
345 # delete any item fields from incoming record to avoid
346 # duplication or incorrect data - use AddItem() or ModItem()
348 foreach my $field ( $record->field($itemtag) ) {
349 $record->delete_field($field);
355 my $error = &DelBiblio($biblionumber);
357 Exported function (core API) for deleting a biblio in koha.
358 Deletes biblio record from Zebra and Koha tables (biblio & biblioitems)
359 Also backs it up to deleted* tables.
360 Checks to make sure that the biblio has no items attached.
362 C<$error> : undef unless an error occurs
367 my ($biblionumber) = @_;
369 my $biblio = Koha::Biblios->find( $biblionumber );
370 return unless $biblio; # Should we throw an exception instead?
372 my $dbh = C4::Context->dbh;
373 my $error; # for error handling
375 # First make sure this biblio has no items attached
376 my $sth = $dbh->prepare("SELECT itemnumber FROM items WHERE biblionumber=?");
377 $sth->execute($biblionumber);
378 if ( my $itemnumber = $sth->fetchrow ) {
380 # Fix this to use a status the template can understand
381 $error .= "This Biblio has items attached, please delete them first before deleting this biblio ";
384 return $error if $error;
386 # We delete attached subscriptions
388 my $subscriptions = C4::Serials::GetFullSubscriptionsFromBiblionumber($biblionumber);
389 foreach my $subscription (@$subscriptions) {
390 C4::Serials::DelSubscription( $subscription->{subscriptionid} );
393 # We delete any existing holds
394 my $holds = $biblio->holds;
395 while ( my $hold = $holds->next ) {
399 # Delete in Zebra. Be careful NOT to move this line after _koha_delete_biblio
400 # for at least 2 reasons :
401 # - if something goes wrong, the biblio may be deleted from Koha but not from zebra
402 # 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)
403 ModZebra( $biblionumber, "recordDelete", "biblioserver" );
405 # delete biblioitems and items from Koha tables and save in deletedbiblioitems,deleteditems
406 $sth = $dbh->prepare("SELECT biblioitemnumber FROM biblioitems WHERE biblionumber=?");
407 $sth->execute($biblionumber);
408 while ( my $biblioitemnumber = $sth->fetchrow ) {
410 # delete this biblioitem
411 $error = _koha_delete_biblioitems( $dbh, $biblioitemnumber );
412 return $error if $error;
416 # delete biblio from Koha tables and save in deletedbiblio
417 # must do this *after* _koha_delete_biblioitems, otherwise
418 # delete cascade will prevent deletedbiblioitems rows
419 # from being generated by _koha_delete_biblioitems
420 $error = _koha_delete_biblio( $dbh, $biblionumber );
422 logaction( "CATALOGUING", "DELETE", $biblionumber, "biblio" ) if C4::Context->preference("CataloguingLog");
428 =head2 BiblioAutoLink
430 my $headings_linked = BiblioAutoLink($record, $frameworkcode)
432 Automatically links headings in a bib record to authorities.
434 Returns the number of headings changed
440 my $frameworkcode = shift;
442 carp('Undefined record passed to BiblioAutoLink');
445 my ( $num_headings_changed, %results );
448 "C4::Linker::" . ( C4::Context->preference("LinkerModule") || 'Default' );
449 unless ( can_load( modules => { $linker_module => undef } ) ) {
450 $linker_module = 'C4::Linker::Default';
451 unless ( can_load( modules => { $linker_module => undef } ) ) {
456 my $linker = $linker_module->new(
457 { 'options' => C4::Context->preference("LinkerOptions") } );
458 my ( $headings_changed, undef ) =
459 LinkBibHeadingsToAuthorities( $linker, $record, $frameworkcode, C4::Context->preference("CatalogModuleRelink") || '' );
460 # By default we probably don't want to relink things when cataloging
461 return $headings_changed;
464 =head2 LinkBibHeadingsToAuthorities
466 my $num_headings_changed, %results = LinkBibHeadingsToAuthorities($linker, $marc, $frameworkcode, [$allowrelink]);
468 Links bib headings to authority records by checking
469 each authority-controlled field in the C<MARC::Record>
470 object C<$marc>, looking for a matching authority record,
471 and setting the linking subfield $9 to the ID of that
474 If $allowrelink is false, existing authids will never be
475 replaced, regardless of the values of LinkerKeepStale and
478 Returns the number of heading links changed in the
483 sub LinkBibHeadingsToAuthorities {
486 my $frameworkcode = shift;
487 my $allowrelink = shift;
490 carp 'LinkBibHeadingsToAuthorities called on undefined bib record';
494 require C4::AuthoritiesMarc;
496 $allowrelink = 1 unless defined $allowrelink;
497 my $num_headings_changed = 0;
498 foreach my $field ( $bib->fields() ) {
499 my $heading = C4::Heading->new_from_bib_field( $field, $frameworkcode );
500 next unless defined $heading;
503 my $current_link = $field->subfield('9');
505 if ( defined $current_link && (!$allowrelink || !C4::Context->preference('LinkerRelink')) )
507 $results{'linked'}->{ $heading->display_form() }++;
511 my ( $authid, $fuzzy ) = $linker->get_link($heading);
513 $results{ $fuzzy ? 'fuzzy' : 'linked' }
514 ->{ $heading->display_form() }++;
515 next if defined $current_link and $current_link == $authid;
517 $field->delete_subfield( code => '9' ) if defined $current_link;
518 $field->add_subfields( '9', $authid );
519 $num_headings_changed++;
522 if ( defined $current_link
523 && (!$allowrelink || C4::Context->preference('LinkerKeepStale')) )
525 $results{'fuzzy'}->{ $heading->display_form() }++;
527 elsif ( C4::Context->preference('AutoCreateAuthorities') ) {
528 if ( _check_valid_auth_link( $current_link, $field ) ) {
529 $results{'linked'}->{ $heading->display_form() }++;
532 my $authority_type = Koha::Authority::Types->find( $heading->auth_type() );
533 my $marcrecordauth = MARC::Record->new();
534 if ( C4::Context->preference('marcflavour') eq 'MARC21' ) {
535 $marcrecordauth->leader(' nz a22 o 4500');
536 SetMarcUnicodeFlag( $marcrecordauth, 'MARC21' );
538 $field->delete_subfield( code => '9' )
539 if defined $current_link;
541 MARC::Field->new( $authority_type->auth_tag_to_report,
542 '', '', "a" => "" . $field->subfield('a') );
544 $authfield->add_subfields( $_->[0] => $_->[1] )
545 if ( $_->[0] =~ /[A-z]/ && $_->[0] ne "a"
546 && C4::Heading::valid_bib_heading_subfield(
547 $authority_type->auth_tag_to_report, $_->[0] )
549 } $field->subfields();
550 $marcrecordauth->insert_fields_ordered($authfield);
552 # bug 2317: ensure new authority knows it's using UTF-8; currently
553 # only need to do this for MARC21, as MARC::Record->as_xml_record() handles
554 # automatically for UNIMARC (by not transcoding)
555 # FIXME: AddAuthority() instead should simply explicitly require that the MARC::Record
556 # use UTF-8, but as of 2008-08-05, did not want to introduce that kind
557 # of change to a core API just before the 3.0 release.
559 if ( C4::Context->preference('marcflavour') eq 'MARC21' ) {
560 my $userenv = C4::Context->userenv;
562 if ( $userenv && $userenv->{'branch'} ) {
563 $library = Koha::Libraries->find( $userenv->{'branch'} );
565 $marcrecordauth->insert_fields_ordered(
568 'a' => "Machine generated authority record."
572 $bib->author() . ", "
573 . $bib->title_proper() . ", "
574 . $bib->publication_date() . " ";
575 $cite =~ s/^[\s\,]*//;
576 $cite =~ s/[\s\,]*$//;
579 . ( $library ? $library->get_effective_marcorgcode : C4::Context->preference('MARCOrgCode') ) . ")"
580 . $bib->subfield( '999', 'c' ) . ": "
582 $marcrecordauth->insert_fields_ordered(
583 MARC::Field->new( '670', '', '', 'a' => $cite ) );
586 # warn "AUTH RECORD ADDED : ".$marcrecordauth->as_formatted;
589 C4::AuthoritiesMarc::AddAuthority( $marcrecordauth, '',
590 $heading->auth_type() );
591 $field->add_subfields( '9', $authid );
592 $num_headings_changed++;
593 $linker->update_cache($heading, $authid);
594 $results{'added'}->{ $heading->display_form() }++;
597 elsif ( defined $current_link ) {
598 if ( _check_valid_auth_link( $current_link, $field ) ) {
599 $results{'linked'}->{ $heading->display_form() }++;
602 $field->delete_subfield( code => '9' );
603 $num_headings_changed++;
604 $results{'unlinked'}->{ $heading->display_form() }++;
608 $results{'unlinked'}->{ $heading->display_form() }++;
613 return $num_headings_changed, \%results;
616 =head2 _check_valid_auth_link
618 if ( _check_valid_auth_link($authid, $field) ) {
622 Check whether the specified heading-auth link is valid without reference
623 to Zebra. Ideally this code would be in C4::Heading, but that won't be
624 possible until we have de-cycled C4::AuthoritiesMarc, so this is the
629 sub _check_valid_auth_link {
630 my ( $authid, $field ) = @_;
631 require C4::AuthoritiesMarc;
633 my $authorized_heading =
634 C4::AuthoritiesMarc::GetAuthorizedHeading( { 'authid' => $authid } ) || '';
635 return ($field->as_string('abcdefghijklmnopqrstuvwxyz') eq $authorized_heading);
638 =head2 GetRecordValue
640 my $values = GetRecordValue($field, $record, $frameworkcode);
642 Get MARC fields from a keyword defined in fieldmapping table.
647 my ( $field, $record, $frameworkcode ) = @_;
650 carp 'GetRecordValue called with undefined record';
653 my $dbh = C4::Context->dbh;
655 my $sth = $dbh->prepare('SELECT fieldcode, subfieldcode FROM fieldmapping WHERE frameworkcode = ? AND field = ?');
656 $sth->execute( $frameworkcode, $field );
660 while ( my $row = $sth->fetchrow_hashref ) {
661 foreach my $field ( $record->field( $row->{fieldcode} ) ) {
662 if ( ( $row->{subfieldcode} ne "" && $field->subfield( $row->{subfieldcode} ) ) ) {
663 foreach my $subfield ( $field->subfield( $row->{subfieldcode} ) ) {
664 push @result, { 'subfield' => $subfield };
667 } elsif ( $row->{subfieldcode} eq "" ) {
668 push @result, { 'subfield' => $field->as_string() };
678 $data = &GetBiblioData($biblionumber);
680 Returns information about the book with the given biblionumber.
681 C<&GetBiblioData> returns a reference-to-hash. The keys are the fields in
682 the C<biblio> and C<biblioitems> tables in the
685 In addition, C<$data-E<gt>{subject}> is the list of the book's
686 subjects, separated by C<" , "> (space, comma, space).
687 If there are multiple biblioitems with the given biblionumber, only
688 the first one is considered.
694 my $dbh = C4::Context->dbh;
696 my $query = " SELECT * , biblioitems.notes AS bnotes, itemtypes.notforloan as bi_notforloan, biblio.notes
698 LEFT JOIN biblioitems ON biblio.biblionumber = biblioitems.biblionumber
699 LEFT JOIN itemtypes ON biblioitems.itemtype = itemtypes.itemtype
700 WHERE biblio.biblionumber = ?";
702 my $sth = $dbh->prepare($query);
703 $sth->execute($bibnum);
705 $data = $sth->fetchrow_hashref;
709 } # sub GetBiblioData
713 $isbd = &GetISBDView({
714 'record' => $marc_record,
715 'template' => $interface, # opac/intranet
716 'framework' => $framework,
719 Return the ISBD view which can be included in opac and intranet
726 # Expecting record WITH items.
727 my $record = $params->{record};
728 return unless defined $record;
730 my $template = $params->{template} // q{};
731 my $sysprefname = $template eq 'opac' ?
'opacisbd' : 'isbd';
732 my $framework = $params->{framework
};
733 my $itemtype = $framework;
734 my ( $holdingbrtagf, $holdingbrtagsubf ) = &GetMarcFromKohaField
( "items.holdingbranch", $itemtype );
735 my $tagslib = GetMarcStructure
( 1, $itemtype, { unsafe
=> 1 } );
737 my $ISBD = C4
::Context
->preference($sysprefname);
742 foreach my $isbdfield ( split( /#/, $bloc ) ) {
744 # $isbdfield= /(.?.?.?)/;
745 $isbdfield =~ /(\d\d\d)([^\|])?\|(.*)\|(.*)\|(.*)/;
746 my $fieldvalue = $1 || 0;
747 my $subfvalue = $2 || "";
749 my $analysestring = $4;
752 # warn "==> $1 / $2 / $3 / $4";
753 # my $fieldvalue=substr($isbdfield,0,3);
754 if ( $fieldvalue > 0 ) {
755 my $hasputtextbefore = 0;
756 my @fieldslist = $record->field($fieldvalue);
757 @fieldslist = sort { $a->subfield($holdingbrtagsubf) cmp $b->subfield($holdingbrtagsubf) } @fieldslist if ( $fieldvalue eq $holdingbrtagf );
759 # warn "ERROR IN ISBD DEFINITION at : $isbdfield" unless $fieldvalue;
760 # warn "FV : $fieldvalue";
761 if ( $subfvalue ne "" ) {
762 # OPAC hidden subfield
764 if ( ( $template eq 'opac' )
765 && ( $tagslib->{$fieldvalue}->{$subfvalue}->{'hidden'} || 0 ) > 0 );
766 foreach my $field (@fieldslist) {
767 foreach my $subfield ( $field->subfield($subfvalue) ) {
768 my $calculated = $analysestring;
769 my $tag = $field->tag();
772 my $subfieldvalue = GetAuthorisedValueDesc
( $tag, $subfvalue, $subfield, '', $tagslib );
773 my $tagsubf = $tag . $subfvalue;
774 $calculated =~ s/\{(.?.?.?.?)$tagsubf(.*?)\}/$1$subfieldvalue$2\{$1$tagsubf$2\}/g;
775 if ( $template eq "opac" ) { $calculated =~ s
#/cgi-bin/koha/[^/]+/([^.]*.pl\?.*)$#opac-$1#g; }
777 # field builded, store the result
778 if ( $calculated && !$hasputtextbefore ) { # put textbefore if not done
779 $blocres .= $textbefore;
780 $hasputtextbefore = 1;
783 # remove punctuation at start
784 $calculated =~ s/^( |;|:|\.|-)*//g;
785 $blocres .= $calculated;
790 $blocres .= $textafter if $hasputtextbefore;
792 foreach my $field (@fieldslist) {
793 my $calculated = $analysestring;
794 my $tag = $field->tag();
797 my @subf = $field->subfields;
798 for my $i ( 0 .. $#subf ) {
799 my $valuecode = $subf[$i][1];
800 my $subfieldcode = $subf[$i][0];
801 # OPAC hidden subfield
803 if ( ( $template eq 'opac' )
804 && ( $tagslib->{$fieldvalue}->{$subfieldcode}->{'hidden'} || 0 ) > 0 );
805 my $subfieldvalue = GetAuthorisedValueDesc
( $tag, $subf[$i][0], $subf[$i][1], '', $tagslib );
806 my $tagsubf = $tag . $subfieldcode;
808 $calculated =~ s
/ # replace all {{}} codes by the value code.
809 \
{\
{$tagsubf\
}\
} # catch the {{actualcode}}
811 $valuecode # replace by the value code
814 $calculated =~ s/\{(.?.?.?.?)$tagsubf(.*?)\}/$1$subfieldvalue$2\{$1$tagsubf$2\}/g;
815 if ( $template eq "opac" ) { $calculated =~ s
#/cgi-bin/koha/[^/]+/([^.]*.pl\?.*)$#opac-$1#g; }
818 # field builded, store the result
819 if ( $calculated && !$hasputtextbefore ) { # put textbefore if not done
820 $blocres .= $textbefore;
821 $hasputtextbefore = 1;
824 # remove punctuation at start
825 $calculated =~ s/^( |;|:|\.|-)*//g;
826 $blocres .= $calculated;
829 $blocres .= $textafter if $hasputtextbefore;
832 $blocres .= $isbdfield;
837 $res =~ s/\{(.*?)\}//g;
839 $res =~ s/\n/<br\/>/g
;
847 =head1 FUNCTIONS FOR HANDLING MARC MANAGEMENT
849 =head2 IsMarcStructureInternal
851 my $tagslib = C4::Biblio::GetMarcStructure();
852 for my $tag ( sort keys %$tagslib ) {
854 for my $subfield ( sort keys %{ $tagslib->{$tag} } ) {
855 next if IsMarcStructureInternal($tagslib->{$tag}{$subfield});
860 GetMarcStructure creates keys (lib, tab, mandatory, repeatable) for a display purpose.
861 These different values should not be processed as valid subfields.
865 sub IsMarcStructureInternal
{
866 my ( $subfield ) = @_;
867 return ref $subfield ?
0 : 1;
870 =head2 GetMarcStructure
872 $res = GetMarcStructure($forlibrarian, $frameworkcode, [ $params ]);
874 Returns a reference to a big hash of hash, with the Marc structure for the given frameworkcode
875 $forlibrarian :if set to 1, the MARC descriptions are the librarians ones, otherwise it's the public (OPAC) ones
876 $frameworkcode : the framework code to read
877 $params allows you to pass { unsafe => 1 } for better performance.
879 Note: If you call GetMarcStructure with unsafe => 1, do not modify or
880 even autovivify its contents. It is a cached/shared data structure. Your
881 changes c/would be passed around in subsequent calls.
885 sub GetMarcStructure
{
886 my ( $forlibrarian, $frameworkcode, $params ) = @_;
887 $frameworkcode = "" unless $frameworkcode;
889 $forlibrarian = $forlibrarian ?
1 : 0;
890 my $unsafe = ($params && $params->{unsafe
})?
1: 0;
891 my $cache = Koha
::Caches
->get_instance();
892 my $cache_key = "MarcStructure-$forlibrarian-$frameworkcode";
893 my $cached = $cache->get_from_cache($cache_key, { unsafe
=> $unsafe });
894 return $cached if $cached;
896 my $dbh = C4
::Context
->dbh;
897 my $sth = $dbh->prepare(
898 "SELECT tagfield,liblibrarian,libopac,mandatory,repeatable,ind1_defaultvalue,ind2_defaultvalue
899 FROM marc_tag_structure
900 WHERE frameworkcode=?
903 $sth->execute($frameworkcode);
904 my ( $liblibrarian, $libopac, $tag, $res, $tab, $mandatory, $repeatable, $ind1_defaultvalue, $ind2_defaultvalue );
906 while ( ( $tag, $liblibrarian, $libopac, $mandatory, $repeatable, $ind1_defaultvalue, $ind2_defaultvalue ) = $sth->fetchrow ) {
907 $res->{$tag}->{lib
} = ( $forlibrarian or !$libopac ) ?
$liblibrarian : $libopac;
908 $res->{$tag}->{tab
} = "";
909 $res->{$tag}->{mandatory
} = $mandatory;
910 $res->{$tag}->{repeatable
} = $repeatable;
911 $res->{$tag}->{ind1_defaultvalue
} = $ind1_defaultvalue;
912 $res->{$tag}->{ind2_defaultvalue
} = $ind2_defaultvalue;
915 $sth = $dbh->prepare(
916 "SELECT tagfield,tagsubfield,liblibrarian,libopac,tab,mandatory,repeatable,authorised_value,authtypecode,value_builder,kohafield,seealso,hidden,isurl,link,defaultvalue,maxlength
917 FROM marc_subfield_structure
918 WHERE frameworkcode=?
919 ORDER BY tagfield,tagsubfield
923 $sth->execute($frameworkcode);
926 my $authorised_value;
938 ( $tag, $subfield, $liblibrarian, $libopac, $tab, $mandatory, $repeatable, $authorised_value,
939 $authtypecode, $value_builder, $kohafield, $seealso, $hidden, $isurl, $link, $defaultvalue,
944 $res->{$tag}->{$subfield}->{lib
} = ( $forlibrarian or !$libopac ) ?
$liblibrarian : $libopac;
945 $res->{$tag}->{$subfield}->{tab
} = $tab;
946 $res->{$tag}->{$subfield}->{mandatory
} = $mandatory;
947 $res->{$tag}->{$subfield}->{repeatable
} = $repeatable;
948 $res->{$tag}->{$subfield}->{authorised_value
} = $authorised_value;
949 $res->{$tag}->{$subfield}->{authtypecode
} = $authtypecode;
950 $res->{$tag}->{$subfield}->{value_builder
} = $value_builder;
951 $res->{$tag}->{$subfield}->{kohafield
} = $kohafield;
952 $res->{$tag}->{$subfield}->{seealso
} = $seealso;
953 $res->{$tag}->{$subfield}->{hidden
} = $hidden;
954 $res->{$tag}->{$subfield}->{isurl
} = $isurl;
955 $res->{$tag}->{$subfield}->{'link'} = $link;
956 $res->{$tag}->{$subfield}->{defaultvalue
} = $defaultvalue;
957 $res->{$tag}->{$subfield}->{maxlength
} = $maxlength;
960 $cache->set_in_cache($cache_key, $res);
964 =head2 GetUsedMarcStructure
966 The same function as GetMarcStructure except it just takes field
967 in tab 0-9. (used field)
969 my $results = GetUsedMarcStructure($frameworkcode);
971 C<$results> is a ref to an array which each case contains a ref
972 to a hash which each keys is the columns from marc_subfield_structure
974 C<$frameworkcode> is the framework code.
978 sub GetUsedMarcStructure
{
979 my $frameworkcode = shift || '';
982 FROM marc_subfield_structure
984 AND frameworkcode = ?
985 ORDER BY tagfield, tagsubfield
987 my $sth = C4
::Context
->dbh->prepare($query);
988 $sth->execute($frameworkcode);
989 return $sth->fetchall_arrayref( {} );
994 =head2 GetMarcSubfieldStructure
996 my $structure = GetMarcSubfieldStructure($frameworkcode, [$params]);
998 Returns a reference to hash representing MARC subfield structure
999 for framework with framework code C<$frameworkcode>, C<$params> is
1000 optional and may contain additional options.
1004 =item C<$frameworkcode>
1010 An optional hash reference with additional options.
1011 The following options are supported:
1017 Pass { unsafe => 1 } do disable cached object cloning,
1018 and instead get a shared reference, resulting in better
1019 performance (but care must be taken so that retured object
1022 Note: If you call GetMarcSubfieldStructure with unsafe => 1, do not modify or
1023 even autovivify its contents. It is a cached/shared data structure. Your
1024 changes would be passed around in subsequent calls.
1032 sub GetMarcSubfieldStructure
{
1033 my ( $frameworkcode, $params ) = @_;
1035 $frameworkcode //= '';
1037 my $cache = Koha
::Caches
->get_instance();
1038 my $cache_key = "MarcSubfieldStructure-$frameworkcode";
1039 my $cached = $cache->get_from_cache($cache_key, { unsafe
=> ($params && $params->{unsafe
}) });
1040 return $cached if $cached;
1042 my $dbh = C4
::Context
->dbh;
1043 # We moved to selectall_arrayref since selectall_hashref does not
1044 # keep duplicate mappings on kohafield (like place in 260 vs 264)
1045 my $subfield_aref = $dbh->selectall_arrayref( q
|
1047 FROM marc_subfield_structure
1048 WHERE frameworkcode
= ?
1050 ORDER BY frameworkcode
,tagfield
,tagsubfield
1051 |, { Slice
=> {} }, $frameworkcode );
1052 # Now map the output to a hash structure
1053 my $subfield_structure = {};
1054 foreach my $row ( @
$subfield_aref ) {
1055 push @
{ $subfield_structure->{ $row->{kohafield
} }}, $row;
1057 $cache->set_in_cache( $cache_key, $subfield_structure );
1058 return $subfield_structure;
1061 =head2 GetMarcFromKohaField
1063 ( $field,$subfield ) = GetMarcFromKohaField( $kohafield );
1064 @fields = GetMarcFromKohaField( $kohafield );
1065 $field = GetMarcFromKohaField( $kohafield );
1067 Returns the MARC fields & subfields mapped to $kohafield.
1068 Since the Default framework is considered as authoritative for such
1069 mappings, the former frameworkcode parameter is obsoleted.
1071 In list context all mappings are returned; there can be multiple
1072 mappings. Note that in the above example you could miss a second
1073 mappings in the first call.
1074 In scalar context only the field tag of the first mapping is returned.
1078 sub GetMarcFromKohaField
{
1079 my ( $kohafield ) = @_;
1080 return unless $kohafield;
1081 # The next call uses the Default framework since it is AUTHORITATIVE
1082 # for all Koha to MARC mappings.
1083 my $mss = GetMarcSubfieldStructure
( '', { unsafe
=> 1 } ); # Do not change framework
1085 foreach( @
{ $mss->{$kohafield} } ) {
1086 push @retval, $_->{tagfield
}, $_->{tagsubfield
};
1088 return wantarray ?
@retval : ( @retval ?
$retval[0] : undef );
1091 =head2 GetMarcSubfieldStructureFromKohaField
1093 my $str = GetMarcSubfieldStructureFromKohaField( $kohafield );
1095 Returns marc subfield structure information for $kohafield.
1096 The Default framework is used, since it is authoritative for kohafield
1098 In list context returns a list of all hashrefs, since there may be
1099 multiple mappings. In scalar context the first hashref is returned.
1103 sub GetMarcSubfieldStructureFromKohaField
{
1104 my ( $kohafield ) = @_;
1106 return unless $kohafield;
1108 # The next call uses the Default framework since it is AUTHORITATIVE
1109 # for all Koha to MARC mappings.
1110 my $mss = GetMarcSubfieldStructure
( '', { unsafe
=> 1 } ); # Do not change framework
1111 return unless $mss->{$kohafield};
1112 return wantarray ? @
{$mss->{$kohafield}} : $mss->{$kohafield}->[0];
1115 =head2 GetMarcBiblio
1117 my $record = GetMarcBiblio({
1118 biblionumber => $biblionumber,
1119 embed_items => $embeditems,
1121 borcat => $patron_category });
1123 Returns MARC::Record representing a biblio record, or C<undef> if the
1124 biblionumber doesn't exist.
1126 Both embed_items and opac are optional.
1127 If embed_items is passed and is 1, items are embedded.
1128 If opac is passed and is 1, the record is filtered as needed.
1132 =item C<$biblionumber>
1136 =item C<$embeditems>
1138 set to true to include item information.
1142 set to true to make the result suited for OPAC view. This causes things like
1143 OpacHiddenItems to be applied.
1147 If the OpacHiddenItemsExceptions system preference is set, this patron category
1148 can be used to make visible OPAC items which would be normally hidden.
1149 It only makes sense in combination both embed_items and opac values true.
1158 if (not defined $params) {
1159 carp
'GetMarcBiblio called without parameters';
1163 my $biblionumber = $params->{biblionumber
};
1164 my $embeditems = $params->{embed_items
} || 0;
1165 my $opac = $params->{opac
} || 0;
1166 my $borcat = $params->{borcat
} // q{};
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
({
1195 marc_record
=> $record,
1196 biblionumber
=> $biblionumber,
1198 borcat
=> $borcat })
1210 my $marcxml = GetXmlBiblio($biblionumber);
1212 Returns biblio_metadata.metadata/marcxml of the biblionumber passed in parameter.
1213 The XML should only contain biblio information (item information is no longer stored in marcxml field)
1218 my ($biblionumber) = @_;
1219 my $dbh = C4
::Context
->dbh;
1220 return unless $biblionumber;
1221 my ($marcxml) = $dbh->selectrow_array(
1224 FROM biblio_metadata
1225 WHERE biblionumber
=?
1226 AND format
='marcxml'
1228 |, undef, $biblionumber, C4
::Context
->preference('marcflavour')
1233 =head2 GetCOinSBiblio
1235 my $coins = GetCOinSBiblio($record);
1237 Returns the COinS (a span) which can be included in a biblio record
1241 sub GetCOinSBiblio
{
1244 # get the coin format
1246 carp
'GetCOinSBiblio called with undefined record';
1249 my $pos7 = substr $record->leader(), 7, 1;
1250 my $pos6 = substr $record->leader(), 6, 1;
1253 my ( $aulast, $aufirst ) = ( '', '' );
1262 my $titletype = 'b';
1264 # For the purposes of generating COinS metadata, LDR/06-07 can be
1265 # considered the same for UNIMARC and MARC21
1270 'b' => 'manuscript',
1272 'd' => 'manuscript',
1276 'i' => 'audioRecording',
1277 'j' => 'audioRecording',
1280 'm' => 'computerProgram',
1285 'a' => 'journalArticle',
1289 $genre = $fmts6->{$pos6} ?
$fmts6->{$pos6} : 'book';
1291 if ( $genre eq 'book' ) {
1292 $genre = $fmts7->{$pos7} if $fmts7->{$pos7};
1295 ##### We must transform mtx to a valable mtx and document type ####
1296 if ( $genre eq 'book' ) {
1298 } elsif ( $genre eq 'journal' ) {
1301 } elsif ( $genre eq 'journalArticle' ) {
1309 $genre = ( $mtx eq 'dc' ) ?
"&rft.type=$genre" : "&rft.genre=$genre";
1311 if ( C4
::Context
->preference("marcflavour") eq "UNIMARC" ) {
1314 $aulast = $record->subfield( '700', 'a' ) || '';
1315 $aufirst = $record->subfield( '700', 'b' ) || '';
1316 $oauthors = "&rft.au=$aufirst $aulast";
1319 if ( $record->field('200') ) {
1320 for my $au ( $record->field('200')->subfield('g') ) {
1321 $oauthors .= "&rft.au=$au";
1326 ?
"&rft.title=" . $record->subfield( '200', 'a' )
1327 : "&rft.title=" . $record->subfield( '200', 'a' ) . "&rft.btitle=" . $record->subfield( '200', 'a' );
1328 $pubyear = $record->subfield( '210', 'd' ) || '';
1329 $publisher = $record->subfield( '210', 'c' ) || '';
1330 $isbn = $record->subfield( '010', 'a' ) || '';
1331 $issn = $record->subfield( '011', 'a' ) || '';
1334 # MARC21 need some improve
1337 if ( $record->field('100') ) {
1338 $oauthors .= "&rft.au=" . $record->subfield( '100', 'a' );
1342 if ( $record->field('700') ) {
1343 for my $au ( $record->field('700')->subfield('a') ) {
1344 $oauthors .= "&rft.au=$au";
1347 $title = "&rft." . $titletype . "title=" . $record->subfield( '245', 'a' );
1348 $subtitle = $record->subfield( '245', 'b' ) || '';
1349 $title .= $subtitle;
1350 if ($titletype eq 'a') {
1351 $pubyear = $record->field('008') || '';
1352 $pubyear = substr($pubyear->data(), 7, 4) if $pubyear;
1353 $isbn = $record->subfield( '773', 'z' ) || '';
1354 $issn = $record->subfield( '773', 'x' ) || '';
1355 if ($mtx eq 'journal') {
1356 $title .= "&rft.title=" . ( $record->subfield( '773', 't' ) || $record->subfield( '773', 'a') || q{} );
1358 $title .= "&rft.btitle=" . ( $record->subfield( '773', 't' ) || $record->subfield( '773', 'a') || q{} );
1360 foreach my $rel ($record->subfield( '773', 'g' )) {
1367 $pubyear = $record->subfield( '260', 'c' ) || '';
1368 $publisher = $record->subfield( '260', 'b' ) || '';
1369 $isbn = $record->subfield( '020', 'a' ) || '';
1370 $issn = $record->subfield( '022', 'a' ) || '';
1375 "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";
1376 $coins_value =~ s/(\ |&[^a])/\+/g;
1377 $coins_value =~ s/\"/\"\;/g;
1379 #<!-- 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="
1381 return $coins_value;
1387 return the prices in accordance with the Marc format.
1389 returns 0 if no price found
1390 returns undef if called without a marc record or with
1391 an unrecognized marc format
1396 my ( $record, $marcflavour ) = @_;
1398 carp
'GetMarcPrice called on undefined record';
1405 if ( $marcflavour eq "MARC21" || $marcflavour eq "NORMARC" ) {
1406 @listtags = ('345', '020');
1408 } elsif ( $marcflavour eq "UNIMARC" ) {
1409 @listtags = ('345', '010');
1415 for my $field ( $record->field(@listtags) ) {
1416 for my $subfield_value ($field->subfield($subfield)){
1418 $subfield_value = MungeMarcPrice
( $subfield_value );
1419 return $subfield_value if ($subfield_value);
1422 return 0; # no price found
1425 =head2 MungeMarcPrice
1427 Return the best guess at what the actual price is from a price field.
1431 sub MungeMarcPrice
{
1433 return unless ( $price =~ m/\d/ ); ## No digits means no price.
1434 # Look for the currency symbol and the normalized code of the active currency, if it's there,
1435 my $active_currency = Koha
::Acquisition
::Currencies
->get_active;
1436 my $symbol = $active_currency->symbol;
1437 my $isocode = $active_currency->isocode;
1438 $isocode = $active_currency->currency unless defined $isocode;
1441 my @matches =($price=~ /
1443 ( # start of capturing parenthesis
1445 (?
:[\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'
1446 |(?
:\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'
1448 \s?\p
{Sc
}?\s?
# followed or not by a whitespace. \p{Sc}?\s? are for cases like '25$ USD'
1450 (?
:[\p
{Sc
}\p
{L
}\
/.]){1,4} # followed by same block as symbol block
1451 |(?
:\d
+[\p
{P
}\s
]?
){1,4} # or by same block as digits block
1453 \s?\p
{L
}{0,4}\s?
# followed or not by a whitespace. \p{L}{0,4}\s? are for cases like '$9.50 USD'
1454 ) # end of capturing parenthesis
1455 (?
:\p
{P
}|\z
) # followed by a punctuation sign or by the end of the string
1459 foreach ( @matches ) {
1460 $localprice = $_ and last if index($_, $isocode)>=0;
1462 if ( !$localprice ) {
1463 foreach ( @matches ) {
1464 $localprice = $_ and last if $_=~ /(^|[^\p{Sc}\p{L}\/])\Q
$symbol\E
([^\p
{Sc
}\p
{L
}\
/]+\z|\z)/;
1469 if ( $localprice ) {
1470 $price = $localprice;
1472 ## Grab the first number in the string ( can use commas or periods for thousands separator and/or decimal separator )
1473 ( $price ) = $price =~ m/([\d\,\.]+[[\,\.]\d\d]?)/;
1475 # eliminate symbol/isocode, space and any final dot from the string
1476 $price =~ s/[\p{Sc}\p{L}\/ ]|\.$//g
;
1477 # remove comma,dot when used as separators from hundreds
1478 $price =~s/[\,\.](\d{3})/$1/g;
1479 # convert comma to dot to ensure correct display of decimals if existing
1485 =head2 GetMarcQuantity
1487 return the quantity of a book. Used in acquisition only, when importing a file an iso2709 from a bookseller
1488 Warning : this is not really in the marc standard. In Unimarc, Electre (the most widely used bookseller) use the 969$a
1490 returns 0 if no quantity found
1491 returns undef if called without a marc record or with
1492 an unrecognized marc format
1496 sub GetMarcQuantity
{
1497 my ( $record, $marcflavour ) = @_;
1499 carp
'GetMarcQuantity called on undefined record';
1506 if ( $marcflavour eq "MARC21" ) {
1508 } elsif ( $marcflavour eq "UNIMARC" ) {
1509 @listtags = ('969');
1515 for my $field ( $record->field(@listtags) ) {
1516 for my $subfield_value ($field->subfield($subfield)){
1518 if ($subfield_value) {
1519 # in France, the cents separator is the , but sometimes, ppl use a .
1520 # in this case, the price will be x100 when unformatted ! Replace the . by a , to get a proper price calculation
1521 $subfield_value =~ s/\./,/ if C4
::Context
->preference("CurrencyFormat") eq "FR";
1522 return $subfield_value;
1526 return 0; # no price found
1530 =head2 GetAuthorisedValueDesc
1532 my $subfieldvalue =get_authorised_value_desc(
1533 $tag, $subf[$i][0],$subf[$i][1], '', $taglib, $category, $opac);
1535 Retrieve the complete description for a given authorised value.
1537 Now takes $category and $value pair too.
1539 my $auth_value_desc =GetAuthorisedValueDesc(
1540 '','', 'DVD' ,'','','CCODE');
1542 If the optional $opac parameter is set to a true value, displays OPAC
1543 descriptions rather than normal ones when they exist.
1547 sub GetAuthorisedValueDesc
{
1548 my ( $tag, $subfield, $value, $framework, $tagslib, $category, $opac ) = @_;
1552 return $value unless defined $tagslib->{$tag}->{$subfield}->{'authorised_value'};
1555 if ( $tagslib->{$tag}->{$subfield}->{'authorised_value'} eq "branches" ) {
1556 my $branch = Koha
::Libraries
->find($value);
1557 return $branch?
$branch->branchname: q{};
1561 if ( $tagslib->{$tag}->{$subfield}->{'authorised_value'} eq "itemtypes" ) {
1562 my $itemtype = Koha
::ItemTypes
->find( $value );
1563 return $itemtype ?
$itemtype->translated_description : q
||;
1566 #---- "true" authorized value
1567 $category = $tagslib->{$tag}->{$subfield}->{'authorised_value'};
1570 my $dbh = C4
::Context
->dbh;
1571 if ( $category ne "" ) {
1572 my $sth = $dbh->prepare( "SELECT lib, lib_opac FROM authorised_values WHERE category = ? AND authorised_value = ?" );
1573 $sth->execute( $category, $value );
1574 my $data = $sth->fetchrow_hashref;
1575 return ( $opac && $data->{'lib_opac'} ) ?
$data->{'lib_opac'} : $data->{'lib'};
1577 return $value; # if nothing is found return the original value
1581 =head2 GetMarcControlnumber
1583 $marccontrolnumber = GetMarcControlnumber($record,$marcflavour);
1585 Get the control number / record Identifier from the MARC record and return it.
1589 sub GetMarcControlnumber
{
1590 my ( $record, $marcflavour ) = @_;
1592 carp
'GetMarcControlnumber called on undefined record';
1595 my $controlnumber = "";
1596 # Control number or Record identifier are the same field in MARC21, UNIMARC and NORMARC
1597 # Keep $marcflavour for possible later use
1598 if ($marcflavour eq "MARC21" || $marcflavour eq "UNIMARC" || $marcflavour eq "NORMARC") {
1599 my $controlnumberField = $record->field('001');
1600 if ($controlnumberField) {
1601 $controlnumber = $controlnumberField->data();
1604 return $controlnumber;
1609 $marcisbnsarray = GetMarcISBN( $record, $marcflavour );
1611 Get all ISBNs from the MARC record and returns them in an array.
1612 ISBNs stored in different fields depending on MARC flavour
1617 my ( $record, $marcflavour ) = @_;
1619 carp
'GetMarcISBN called on undefined record';
1623 if ( $marcflavour eq "UNIMARC" ) {
1625 } else { # assume marc21 if not unimarc
1630 foreach my $field ( $record->field($scope) ) {
1631 my $isbn = $field->subfield( 'a' );
1632 if ( $isbn ne "" ) {
1633 push @marcisbns, $isbn;
1643 $marcissnsarray = GetMarcISSN( $record, $marcflavour );
1645 Get all valid ISSNs from the MARC record and returns them in an array.
1646 ISSNs are stored in different fields depending on MARC flavour
1651 my ( $record, $marcflavour ) = @_;
1653 carp
'GetMarcISSN called on undefined record';
1657 if ( $marcflavour eq "UNIMARC" ) {
1660 else { # assume MARC21 or NORMARC
1664 foreach my $field ( $record->field($scope) ) {
1665 push @marcissns, $field->subfield( 'a' )
1666 if ( $field->subfield( 'a' ) ne "" );
1673 $marcnotesarray = GetMarcNotes( $record, $marcflavour );
1675 Get all notes from the MARC record and returns them in an array.
1676 The notes are stored in different fields depending on MARC flavour.
1677 MARC21 5XX $u subfields receive special attention as they are URIs.
1682 my ( $record, $marcflavour ) = @_;
1684 carp
'GetMarcNotes called on undefined record';
1688 my $scope = $marcflavour eq "UNIMARC"?
'3..': '5..';
1690 my %blacklist = map { $_ => 1 }
1691 split( /,/, C4
::Context
->preference('NotesBlacklist'));
1692 foreach my $field ( $record->field($scope) ) {
1693 my $tag = $field->tag();
1694 next if $blacklist{ $tag };
1695 if( $marcflavour ne 'UNIMARC' && $field->subfield('u') ) {
1696 # Field 5XX$u always contains URI
1697 # Examples: 505u, 506u, 510u, 514u, 520u, 530u, 538u, 540u, 542u, 552u, 555u, 561u, 563u, 583u
1698 # We first push the other subfields, then all $u's separately
1699 # Leave further actions to the template (see e.g. opac-detail)
1701 join '', ( 'a' .. 't', 'v' .. 'z', '0' .. '9' ); # excl 'u'
1702 push @marcnotes, { marcnote
=> $field->as_string($othersub) };
1703 foreach my $sub ( $field->subfield('u') ) {
1704 $sub =~ s/^\s+|\s+$//g; # trim
1705 push @marcnotes, { marcnote
=> $sub };
1708 push @marcnotes, { marcnote
=> $field->as_string() };
1714 =head2 GetMarcSubjects
1716 $marcsubjcts = GetMarcSubjects($record,$marcflavour);
1718 Get all subjects from the MARC record and returns them in an array.
1719 The subjects are stored in different fields depending on MARC flavour
1723 sub GetMarcSubjects
{
1724 my ( $record, $marcflavour ) = @_;
1726 carp
'GetMarcSubjects called on undefined record';
1729 my ( $mintag, $maxtag, $fields_filter );
1730 if ( $marcflavour eq "UNIMARC" ) {
1733 $fields_filter = '6..';
1734 } else { # marc21/normarc
1737 $fields_filter = '6..';
1742 my $subject_limit = C4
::Context
->preference("TraceCompleteSubfields") ?
'su,complete-subfield' : 'su';
1743 my $AuthoritySeparator = C4
::Context
->preference('AuthoritySeparator');
1745 foreach my $field ( $record->field($fields_filter) ) {
1746 next unless ($field->tag() >= $mintag && $field->tag() <= $maxtag);
1748 my @subfields = $field->subfields();
1751 # if there is an authority link, build the links with an= subfield9
1752 my $subfield9 = $field->subfield('9');
1755 my $linkvalue = $subfield9;
1756 $linkvalue =~ s/(\(|\))//g;
1757 @link_loop = ( { limit
=> 'an', 'link' => $linkvalue } );
1758 $authoritylink = $linkvalue
1762 for my $subject_subfield (@subfields) {
1763 next if ( $subject_subfield->[0] eq '9' );
1765 # don't load unimarc subfields 3,4,5
1766 next if ( ( $marcflavour eq "UNIMARC" ) and ( $subject_subfield->[0] =~ /2|3|4|5/ ) );
1767 # don't load MARC21 subfields 2 (FIXME: any more subfields??)
1768 next if ( ( $marcflavour eq "MARC21" ) and ( $subject_subfield->[0] =~ /2/ ) );
1770 my $code = $subject_subfield->[0];
1771 my $value = $subject_subfield->[1];
1772 my $linkvalue = $value;
1773 $linkvalue =~ s/(\(|\))//g;
1774 # if no authority link, build a search query
1775 unless ($subfield9) {
1777 limit
=> $subject_limit,
1778 'link' => $linkvalue,
1779 operator
=> (scalar @link_loop) ?
' and ' : undef
1782 my @this_link_loop = @link_loop;
1784 unless ( $code eq '0' ) {
1785 push @subfields_loop, {
1788 link_loop
=> \
@this_link_loop,
1789 separator
=> (scalar @subfields_loop) ?
$AuthoritySeparator : ''
1794 push @marcsubjects, {
1795 MARCSUBJECT_SUBFIELDS_LOOP
=> \
@subfields_loop,
1796 authoritylink
=> $authoritylink,
1797 } if $authoritylink || @subfields_loop;
1800 return \
@marcsubjects;
1801 } #end getMARCsubjects
1803 =head2 GetMarcAuthors
1805 authors = GetMarcAuthors($record,$marcflavour);
1807 Get all authors from the MARC record and returns them in an array.
1808 The authors are stored in different fields depending on MARC flavour
1812 sub GetMarcAuthors
{
1813 my ( $record, $marcflavour ) = @_;
1815 carp
'GetMarcAuthors called on undefined record';
1818 my ( $mintag, $maxtag, $fields_filter );
1820 # tagslib useful only for UNIMARC author responsibilities
1822 if ( $marcflavour eq "UNIMARC" ) {
1823 # FIXME : we don't have the framework available, we take the default framework. May be buggy on some setups, will be usually correct.
1824 $tagslib = GetMarcStructure
( 1, '', { unsafe
=> 1 });
1827 $fields_filter = '7..';
1828 } else { # marc21/normarc
1831 $fields_filter = '7..';
1835 my $AuthoritySeparator = C4
::Context
->preference('AuthoritySeparator');
1837 foreach my $field ( $record->field($fields_filter) ) {
1838 next unless $field->tag() >= $mintag && $field->tag() <= $maxtag;
1841 my @subfields = $field->subfields();
1844 # if there is an authority link, build the link with Koha-Auth-Number: subfield9
1845 my $subfield9 = $field->subfield('9');
1847 my $linkvalue = $subfield9;
1848 $linkvalue =~ s/(\(|\))//g;
1849 @link_loop = ( { 'limit' => 'an', 'link' => $linkvalue } );
1854 for my $authors_subfield (@subfields) {
1855 next if ( $authors_subfield->[0] eq '9' );
1857 # unimarc3 contains the $3 of the author for UNIMARC.
1858 # For french academic libraries, it's the "ppn", and it's required for idref webservice
1859 $unimarc3 = $authors_subfield->[1] if $marcflavour eq 'UNIMARC' and $authors_subfield->[0] =~ /3/;
1861 # don't load unimarc subfields 3, 5
1862 next if ( $marcflavour eq 'UNIMARC' and ( $authors_subfield->[0] =~ /3|5/ ) );
1864 my $code = $authors_subfield->[0];
1865 my $value = $authors_subfield->[1];
1866 my $linkvalue = $value;
1867 $linkvalue =~ s/(\(|\))//g;
1868 # UNIMARC author responsibility
1869 if ( $marcflavour eq 'UNIMARC' and $code eq '4' ) {
1870 $value = GetAuthorisedValueDesc
( $field->tag(), $code, $value, '', $tagslib );
1871 $linkvalue = "($value)";
1873 # if no authority link, build a search query
1874 unless ($subfield9) {
1877 'link' => $linkvalue,
1878 operator
=> (scalar @link_loop) ?
' and ' : undef
1881 my @this_link_loop = @link_loop;
1883 unless ( $code eq '0') {
1884 push @subfields_loop, {
1885 tag
=> $field->tag(),
1888 link_loop
=> \
@this_link_loop,
1889 separator
=> (scalar @subfields_loop) ?
$AuthoritySeparator : ''
1893 push @marcauthors, {
1894 MARCAUTHOR_SUBFIELDS_LOOP
=> \
@subfields_loop,
1895 authoritylink
=> $subfield9,
1896 unimarc3
=> $unimarc3
1899 return \
@marcauthors;
1904 $marcurls = GetMarcUrls($record,$marcflavour);
1906 Returns arrayref of URLs from MARC data, suitable to pass to tmpl loop.
1907 Assumes web resources (not uncommon in MARC21 to omit resource type ind)
1912 my ( $record, $marcflavour ) = @_;
1914 carp
'GetMarcUrls called on undefined record';
1919 for my $field ( $record->field('856') ) {
1921 for my $note ( $field->subfield('z') ) {
1922 push @notes, { note
=> $note };
1924 my @urls = $field->subfield('u');
1925 foreach my $url (@urls) {
1926 $url =~ s/^\s+|\s+$//g; # trim
1928 if ( $marcflavour eq 'MARC21' ) {
1929 my $s3 = $field->subfield('3');
1930 my $link = $field->subfield('y');
1931 unless ( $url =~ /^\w+:/ ) {
1932 if ( $field->indicator(1) eq '7' ) {
1933 $url = $field->subfield('2') . "://" . $url;
1934 } elsif ( $field->indicator(1) eq '1' ) {
1935 $url = 'ftp://' . $url;
1938 # properly, this should be if ind1=4,
1939 # however we will assume http protocol since we're building a link.
1940 $url = 'http://' . $url;
1944 # TODO handle ind 2 (relationship)
1949 $marcurl->{'linktext'} = $link || $s3 || C4
::Context
->preference('URLLinkText') || $url;
1950 $marcurl->{'part'} = $s3 if ($link);
1951 $marcurl->{'toc'} = 1 if ( defined($s3) && $s3 =~ /^[Tt]able/ );
1953 $marcurl->{'linktext'} = $field->subfield('2') || C4
::Context
->preference('URLLinkText') || $url;
1954 $marcurl->{'MARCURL'} = $url;
1956 push @marcurls, $marcurl;
1962 =head2 GetMarcSeries
1964 $marcseriesarray = GetMarcSeries($record,$marcflavour);
1966 Get all series from the MARC record and returns them in an array.
1967 The series are stored in different fields depending on MARC flavour
1972 my ( $record, $marcflavour ) = @_;
1974 carp
'GetMarcSeries called on undefined record';
1978 my ( $mintag, $maxtag, $fields_filter );
1979 if ( $marcflavour eq "UNIMARC" ) {
1982 $fields_filter = '2..';
1983 } else { # marc21/normarc
1986 $fields_filter = '4..';
1990 my $AuthoritySeparator = C4
::Context
->preference('AuthoritySeparator');
1992 foreach my $field ( $record->field($fields_filter) ) {
1993 next unless $field->tag() >= $mintag && $field->tag() <= $maxtag;
1995 my @subfields = $field->subfields();
1998 for my $series_subfield (@subfields) {
2000 # ignore $9, used for authority link
2001 next if ( $series_subfield->[0] eq '9' );
2004 my $code = $series_subfield->[0];
2005 my $value = $series_subfield->[1];
2006 my $linkvalue = $value;
2007 $linkvalue =~ s/(\(|\))//g;
2009 # see if this is an instance of a volume
2010 if ( $code eq 'v' ) {
2015 'link' => $linkvalue,
2016 operator
=> (scalar @link_loop) ?
' and ' : undef
2019 if ($volume_number) {
2020 push @subfields_loop, { volumenum
=> $value };
2022 push @subfields_loop, {
2025 link_loop
=> \
@link_loop,
2026 separator
=> (scalar @subfields_loop) ?
$AuthoritySeparator : '',
2027 volumenum
=> $volume_number,
2031 push @marcseries, { MARCSERIES_SUBFIELDS_LOOP
=> \
@subfields_loop };
2034 return \
@marcseries;
2035 } #end getMARCseriess
2039 $marchostsarray = GetMarcHosts($record,$marcflavour);
2041 Get all host records (773s MARC21, 461 UNIMARC) from the MARC record and returns them in an array.
2046 my ( $record, $marcflavour ) = @_;
2048 carp
'GetMarcHosts called on undefined record';
2052 my ( $tag,$title_subf,$bibnumber_subf,$itemnumber_subf);
2053 $marcflavour ||="MARC21";
2054 if ( $marcflavour eq "MARC21" || $marcflavour eq "NORMARC" ) {
2057 $bibnumber_subf ="0";
2058 $itemnumber_subf='9';
2060 elsif ($marcflavour eq "UNIMARC") {
2063 $bibnumber_subf ="0";
2064 $itemnumber_subf='9';
2069 foreach my $field ( $record->field($tag)) {
2073 my $hostbiblionumber = $field->subfield("$bibnumber_subf");
2074 my $hosttitle = $field->subfield($title_subf);
2075 my $hostitemnumber=$field->subfield($itemnumber_subf);
2076 push @fields_loop, { hostbiblionumber
=> $hostbiblionumber, hosttitle
=> $hosttitle, hostitemnumber
=> $hostitemnumber};
2077 push @marchosts, { MARCHOSTS_FIELDS_LOOP
=> \
@fields_loop };
2080 my $marchostsarray = \
@marchosts;
2081 return $marchostsarray;
2084 =head2 UpsertMarcSubfield
2086 my $record = C4::Biblio::UpsertMarcSubfield($MARC::Record, $fieldTag, $subfieldCode, $subfieldContent);
2090 sub UpsertMarcSubfield
{
2091 my ($record, $tag, $code, $content) = @_;
2092 my $f = $record->field($tag);
2095 $f->update( $code => $content );
2098 my $f = MARC
::Field
->new( $tag, '', '', $code => $content);
2099 $record->insert_fields_ordered( $f );
2103 =head2 UpsertMarcControlField
2105 my $record = C4::Biblio::UpsertMarcControlField($MARC::Record, $fieldTag, $content);
2109 sub UpsertMarcControlField
{
2110 my ($record, $tag, $content) = @_;
2111 die "UpsertMarcControlField() \$tag '$tag' is not a control field\n" unless 0+$tag < 10;
2112 my $f = $record->field($tag);
2115 $f->update( $content );
2118 my $f = MARC
::Field
->new($tag, $content);
2119 $record->insert_fields_ordered( $f );
2123 =head2 GetFrameworkCode
2125 $frameworkcode = GetFrameworkCode( $biblionumber )
2129 sub GetFrameworkCode
{
2130 my ($biblionumber) = @_;
2131 my $dbh = C4
::Context
->dbh;
2132 my $sth = $dbh->prepare("SELECT frameworkcode FROM biblio WHERE biblionumber=?");
2133 $sth->execute($biblionumber);
2134 my ($frameworkcode) = $sth->fetchrow;
2135 return $frameworkcode;
2138 =head2 TransformKohaToMarc
2140 $record = TransformKohaToMarc( $hash [, $params ] )
2142 This function builds a (partial) MARC::Record from a hash.
2143 Hash entries can be from biblio, biblioitems or items.
2144 The params hash includes the parameter no_split used in C4::Items.
2146 This function is called in acquisition module, to create a basic catalogue
2147 entry from user entry.
2152 sub TransformKohaToMarc
{
2153 my ( $hash, $params ) = @_;
2154 my $record = MARC
::Record
->new();
2155 SetMarcUnicodeFlag
( $record, C4
::Context
->preference("marcflavour") );
2157 # In the next call we use the Default framework, since it is considered
2158 # authoritative for Koha to Marc mappings.
2159 my $mss = GetMarcSubfieldStructure
( '', { unsafe
=> 1 } ); # do not change framewok
2161 while ( my ($kohafield, $value) = each %$hash ) {
2162 foreach my $fld ( @
{ $mss->{$kohafield} } ) {
2163 my $tagfield = $fld->{tagfield
};
2164 my $tagsubfield = $fld->{tagsubfield
};
2166 my @values = $params->{no_split
}
2168 : split(/\s?\|\s?/, $value, -1);
2169 foreach my $value ( @values ) {
2170 next if $value eq '';
2171 $tag_hr->{$tagfield} //= [];
2172 push @
{$tag_hr->{$tagfield}}, [($tagsubfield, $value)];
2176 foreach my $tag (sort keys %$tag_hr) {
2177 my @sfl = @
{$tag_hr->{$tag}};
2178 @sfl = sort { $a->[0] cmp $b->[0]; } @sfl;
2179 @sfl = map { @
{$_}; } @sfl;
2180 # Special care for control fields: remove the subfield indication @
2181 # and do not insert indicators.
2182 my @ind = $tag < 10 ?
() : ( " ", " " );
2183 @sfl = grep { $_ ne '@' } @sfl if $tag < 10;
2184 $record->insert_fields_ordered( MARC
::Field
->new($tag, @ind, @sfl) );
2189 =head2 PrepHostMarcField
2191 $hostfield = PrepHostMarcField ( $hostbiblionumber,$hostitemnumber,$marcflavour )
2193 This function returns a host field populated with data from the host record, the field can then be added to an analytical record
2197 sub PrepHostMarcField
{
2198 my ($hostbiblionumber,$hostitemnumber, $marcflavour) = @_;
2199 $marcflavour ||="MARC21";
2201 my $hostrecord = GetMarcBiblio
({ biblionumber
=> $hostbiblionumber });
2202 my $item = Koha
::Items
->find($hostitemnumber);
2205 if ( $marcflavour eq "MARC21" || $marcflavour eq "NORMARC" ) {
2209 if ($hostrecord->subfield('100','a')){
2210 $mainentry = $hostrecord->subfield('100','a');
2211 } elsif ($hostrecord->subfield('110','a')){
2212 $mainentry = $hostrecord->subfield('110','a');
2214 $mainentry = $hostrecord->subfield('111','a');
2217 # qualification info
2219 if (my $field260 = $hostrecord->field('260')){
2220 $qualinfo = $field260->as_string( 'abc' );
2225 my $ed = $hostrecord->subfield('250','a');
2226 my $barcode = $item->barcode;
2227 my $title = $hostrecord->subfield('245','a');
2229 # record control number, 001 with 003 and prefix
2231 if ($hostrecord->field('001')){
2232 $recctrlno = $hostrecord->field('001')->data();
2233 if ($hostrecord->field('003')){
2234 $recctrlno = '('.$hostrecord->field('003')->data().')'.$recctrlno;
2239 my $issn = $hostrecord->subfield('022','a');
2240 my $isbn = $hostrecord->subfield('020','a');
2243 $hostmarcfield = MARC
::Field
->new(
2245 '0' => $hostbiblionumber,
2246 '9' => $hostitemnumber,
2256 } elsif ($marcflavour eq "UNIMARC") {
2257 $hostmarcfield = MARC
::Field
->new(
2259 '0' => $hostbiblionumber,
2260 't' => $hostrecord->subfield('200','a'),
2261 '9' => $hostitemnumber
2265 return $hostmarcfield;
2268 =head2 TransformHtmlToXml
2270 $xml = TransformHtmlToXml( $tags, $subfields, $values, $indicator,
2271 $ind_tag, $auth_type )
2273 $auth_type contains :
2277 =item - nothing : rebuild a biblio. In UNIMARC the encoding is in 100$a pos 26/27
2279 =item - UNIMARCAUTH : rebuild an authority. In UNIMARC, the encoding is in 100$a pos 13/14
2281 =item - ITEM : rebuild an item : in UNIMARC, 100$a, it's in the biblio ! (otherwise, we would get 2 100 fields !)
2287 sub TransformHtmlToXml
{
2288 my ( $tags, $subfields, $values, $indicator, $ind_tag, $auth_type ) = @_;
2289 # NOTE: The parameter $ind_tag is NOT USED -- BZ 11247
2291 my $xml = MARC
::File
::XML
::header
('UTF-8');
2292 $xml .= "<record>\n";
2293 $auth_type = C4
::Context
->preference('marcflavour') unless $auth_type;
2294 MARC
::File
::XML
->default_record_format($auth_type);
2296 # in UNIMARC, field 100 contains the encoding
2297 # check that there is one, otherwise the
2298 # MARC::Record->new_from_xml will fail (and Koha will die)
2299 my $unimarc_and_100_exist = 0;
2300 $unimarc_and_100_exist = 1 if $auth_type eq 'ITEM'; # if we rebuild an item, no need of a 100 field
2306 for ( my $i = 0 ; $i < @
$tags ; $i++ ) {
2308 if ( C4
::Context
->preference('marcflavour') eq 'UNIMARC' and @
$tags[$i] eq "100" and @
$subfields[$i] eq "a" ) {
2310 # if we have a 100 field and it's values are not correct, skip them.
2311 # if we don't have any valid 100 field, we will create a default one at the end
2312 my $enc = substr( @
$values[$i], 26, 2 );
2313 if ( $enc eq '01' or $enc eq '50' or $enc eq '03' ) {
2314 $unimarc_and_100_exist = 1;
2319 @
$values[$i] =~ s/&/&/g;
2320 @
$values[$i] =~ s/</</g;
2321 @
$values[$i] =~ s/>/>/g;
2322 @
$values[$i] =~ s/"/"/g;
2323 @
$values[$i] =~ s/'/'/g;
2325 if ( ( @
$tags[$i] ne $prevtag ) ) {
2326 $close_last_tag = 0;
2327 $j++ unless ( @
$tags[$i] eq "" );
2328 my $indicator1 = eval { substr( @
$indicator[$j], 0, 1 ) };
2329 my $indicator2 = eval { substr( @
$indicator[$j], 1, 1 ) };
2330 my $ind1 = _default_ind_to_space
($indicator1);
2332 if ( @
$indicator[$j] ) {
2333 $ind2 = _default_ind_to_space
($indicator2);
2335 warn "Indicator in @$tags[$i] is empty";
2339 $xml .= "</datafield>\n";
2340 if ( ( @
$tags[$i] && @
$tags[$i] > 10 )
2341 && ( @
$values[$i] ne "" ) ) {
2342 $xml .= "<datafield tag=\"@$tags[$i]\" ind1=\"$ind1\" ind2=\"$ind2\">\n";
2343 $xml .= "<subfield code=\"@$subfields[$i]\">@$values[$i]</subfield>\n";
2345 $close_last_tag = 1;
2350 if ( @
$values[$i] ne "" ) {
2353 if ( @
$tags[$i] eq "000" ) {
2354 $xml .= "<leader>@$values[$i]</leader>\n";
2357 # rest of the fixed fields
2358 } elsif ( @
$tags[$i] < 10 ) {
2359 $xml .= "<controlfield tag=\"@$tags[$i]\">@$values[$i]</controlfield>\n";
2362 $xml .= "<datafield tag=\"@$tags[$i]\" ind1=\"$ind1\" ind2=\"$ind2\">\n";
2363 $xml .= "<subfield code=\"@$subfields[$i]\">@$values[$i]</subfield>\n";
2365 $close_last_tag = 1;
2369 } else { # @$tags[$i] eq $prevtag
2370 my $indicator1 = eval { substr( @
$indicator[$j], 0, 1 ) };
2371 my $indicator2 = eval { substr( @
$indicator[$j], 1, 1 ) };
2372 my $ind1 = _default_ind_to_space
($indicator1);
2374 if ( @
$indicator[$j] ) {
2375 $ind2 = _default_ind_to_space
($indicator2);
2377 warn "Indicator in @$tags[$i] is empty";
2380 if ( @
$values[$i] eq "" ) {
2383 $xml .= "<datafield tag=\"@$tags[$i]\" ind1=\"$ind1\" ind2=\"$ind2\">\n";
2385 $close_last_tag = 1;
2387 $xml .= "<subfield code=\"@$subfields[$i]\">@$values[$i]</subfield>\n";
2390 $prevtag = @
$tags[$i];
2392 $xml .= "</datafield>\n" if $close_last_tag;
2393 if ( C4
::Context
->preference('marcflavour') eq 'UNIMARC' and !$unimarc_and_100_exist ) {
2395 # warn "SETTING 100 for $auth_type";
2396 my $string = strftime
( "%Y%m%d", localtime(time) );
2398 # set 50 to position 26 is biblios, 13 if authorities
2400 $pos = 13 if $auth_type eq 'UNIMARCAUTH';
2401 $string = sprintf( "%-*s", 35, $string );
2402 substr( $string, $pos, 6, "50" );
2403 $xml .= "<datafield tag=\"100\" ind1=\"\" ind2=\"\">\n";
2404 $xml .= "<subfield code=\"a\">$string</subfield>\n";
2405 $xml .= "</datafield>\n";
2407 $xml .= "</record>\n";
2408 $xml .= MARC
::File
::XML
::footer
();
2412 =head2 _default_ind_to_space
2414 Passed what should be an indicator returns a space
2415 if its undefined or zero length
2419 sub _default_ind_to_space
{
2421 if ( !defined $s || $s eq q{} ) {
2427 =head2 TransformHtmlToMarc
2429 L<$record> = TransformHtmlToMarc(L<$cgi>)
2430 L<$cgi> is the CGI object which contains the values for subfields
2432 'tag_010_indicator1_531951' ,
2433 'tag_010_indicator2_531951' ,
2434 'tag_010_code_a_531951_145735' ,
2435 'tag_010_subfield_a_531951_145735' ,
2436 'tag_200_indicator1_873510' ,
2437 'tag_200_indicator2_873510' ,
2438 'tag_200_code_a_873510_673465' ,
2439 'tag_200_subfield_a_873510_673465' ,
2440 'tag_200_code_b_873510_704318' ,
2441 'tag_200_subfield_b_873510_704318' ,
2442 'tag_200_code_e_873510_280822' ,
2443 'tag_200_subfield_e_873510_280822' ,
2444 'tag_200_code_f_873510_110730' ,
2445 'tag_200_subfield_f_873510_110730' ,
2447 L<$record> is the MARC::Record object.
2451 sub TransformHtmlToMarc
{
2452 my ($cgi, $isbiblio) = @_;
2454 my @params = $cgi->multi_param();
2456 # explicitly turn on the UTF-8 flag for all
2457 # 'tag_' parameters to avoid incorrect character
2458 # conversion later on
2459 my $cgi_params = $cgi->Vars;
2460 foreach my $param_name ( keys %$cgi_params ) {
2461 if ( $param_name =~ /^tag_/ ) {
2462 my $param_value = $cgi_params->{$param_name};
2463 unless ( Encode
::is_utf8
( $param_value ) ) {
2464 $cgi_params->{$param_name} = Encode
::decode
('UTF-8', $param_value );
2469 # creating a new record
2470 my $record = MARC
::Record
->new();
2472 my ($biblionumbertagfield, $biblionumbertagsubfield) = (-1, -1);
2473 ($biblionumbertagfield, $biblionumbertagsubfield) =
2474 &GetMarcFromKohaField
( "biblio.biblionumber", '' ) if $isbiblio;
2475 #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!
2476 for (my $i = 0; $params[$i]; $i++ ) { # browse all CGI params
2477 my $param = $params[$i];
2480 # if we are on biblionumber, store it in the MARC::Record (it may not be in the edited fields)
2481 if ( $param eq 'biblionumber' ) {
2482 if ( $biblionumbertagfield < 10 ) {
2483 $newfield = MARC
::Field
->new( $biblionumbertagfield, scalar $cgi->param($param), );
2485 $newfield = MARC
::Field
->new( $biblionumbertagfield, '', '', "$biblionumbertagsubfield" => scalar $cgi->param($param), );
2487 push @fields, $newfield if ($newfield);
2488 } elsif ( $param =~ /^tag_(\d*)_indicator1_/ ) { # new field start when having 'input name="..._indicator1_..."
2491 my $ind1 = _default_ind_to_space
( substr( $cgi->param($param), 0, 1 ) );
2492 my $ind2 = _default_ind_to_space
( substr( $cgi->param( $params[ $i + 1 ] ), 0, 1 ) );
2496 if ( $tag < 10 ) { # no code for theses fields
2497 # in MARC editor, 000 contains the leader.
2498 next if $tag == $biblionumbertagfield;
2499 my $fval= $cgi->param($params[$j+1]);
2500 if ( $tag eq '000' ) {
2501 # Force a fake leader even if not provided to avoid crashing
2502 # during decoding MARC record containing UTF-8 characters
2504 length( $fval ) == 24
2509 # between 001 and 009 (included)
2510 } elsif ( $fval ne '' ) {
2511 $newfield = MARC
::Field
->new( $tag, $fval, );
2514 # > 009, deal with subfields
2516 # browse subfields for this tag (reason for _code_ match)
2517 while(defined $params[$j] && $params[$j] =~ /_code_/) {
2518 last unless defined $params[$j+1];
2520 if $tag == $biblionumbertagfield and
2521 $cgi->param($params[$j]) eq $biblionumbertagsubfield;
2522 #if next param ne subfield, then it was probably empty
2523 #try next param by incrementing j
2524 if($params[$j+1]!~/_subfield_/) {$j++; next; }
2525 my $fkey= $cgi->param($params[$j]);
2526 my $fval= $cgi->param($params[$j+1]);
2527 #check if subfield value not empty and field exists
2528 if($fval ne '' && $newfield) {
2529 $newfield->add_subfields( $fkey => $fval);
2531 elsif($fval ne '') {
2532 $newfield = MARC
::Field
->new( $tag, $ind1, $ind2, $fkey => $fval );
2536 $i= $j-1; #update i for outer loop accordingly
2538 push @fields, $newfield if ($newfield);
2542 $record->append_fields(@fields);
2546 =head2 TransformMarcToKoha
2548 $result = TransformMarcToKoha( $record, undef, $limit )
2550 Extract data from a MARC bib record into a hashref representing
2551 Koha biblio, biblioitems, and items fields.
2553 If passed an undefined record will log the error and return an empty
2558 sub TransformMarcToKoha
{
2559 my ( $record, $frameworkcode, $limit_table ) = @_;
2560 # FIXME Parameter $frameworkcode is obsolete and will be removed
2561 $limit_table //= q{};
2564 if (!defined $record) {
2565 carp
('TransformMarcToKoha called with undefined record');
2569 my %tables = ( biblio
=> 1, biblioitems
=> 1, items
=> 1 );
2570 if( $limit_table eq 'items' ) {
2571 %tables = ( items
=> 1 );
2574 # The next call acknowledges Default as the authoritative framework
2575 # for Koha to MARC mappings.
2576 my $mss = GetMarcSubfieldStructure
( '', { unsafe
=> 1 } ); # Do not change framework
2577 foreach my $kohafield ( keys %{ $mss } ) {
2578 my ( $table, $column ) = split /[.]/, $kohafield, 2;
2579 next unless $tables{$table};
2580 my $val = TransformMarcToKohaOneField
( $kohafield, $record );
2581 next if !defined $val;
2582 my $key = _disambiguate
( $table, $column );
2583 $result->{$key} = $val;
2588 =head2 _disambiguate
2590 $newkey = _disambiguate($table, $field);
2592 This is a temporary hack to distinguish between the
2593 following sets of columns when using TransformMarcToKoha.
2595 items.cn_source & biblioitems.cn_source
2596 items.cn_sort & biblioitems.cn_sort
2598 Columns that are currently NOT distinguished (FIXME
2599 due to lack of time to fully test) are:
2601 biblio.notes and biblioitems.notes
2606 FIXME - this is necessary because prefixing each column
2607 name with the table name would require changing lots
2608 of code and templates, and exposing more of the DB
2609 structure than is good to the UI templates, particularly
2610 since biblio and bibloitems may well merge in a future
2611 version. In the future, it would also be good to
2612 separate DB access and UI presentation field names
2618 my ( $table, $column ) = @_;
2619 if ( $column eq "cn_sort" or $column eq "cn_source" ) {
2620 return $table . '.' . $column;
2627 =head2 TransformMarcToKohaOneField
2629 $val = TransformMarcToKohaOneField( 'biblio.title', $marc );
2631 Note: The authoritative Default framework is used implicitly.
2635 sub TransformMarcToKohaOneField
{
2636 my ( $kohafield, $marc ) = @_;
2638 my ( @rv, $retval );
2639 my @mss = GetMarcSubfieldStructureFromKohaField
($kohafield);
2640 foreach my $fldhash ( @mss ) {
2641 my $tag = $fldhash->{tagfield
};
2642 my $sub = $fldhash->{tagsubfield
};
2643 foreach my $fld ( $marc->field($tag) ) {
2644 if( $sub eq '@' || $fld->is_control_field ) {
2645 push @rv, $fld->data if $fld->data;
2647 push @rv, grep { $_ } $fld->subfield($sub);
2652 $retval = join ' | ', uniq
(@rv);
2654 # Additional polishing for individual kohafields
2655 if( $kohafield =~ /copyrightdate|publicationyear/ ) {
2656 $retval = _adjust_pubyear
( $retval );
2662 =head2 _adjust_pubyear
2664 Helper routine for TransformMarcToKohaOneField
2668 sub _adjust_pubyear
{
2670 # modify return value to keep only the 1st year found
2671 if( $retval =~ m/c(\d\d\d\d)/ and $1 > 0 ) { # search cYYYY first
2673 } elsif( $retval =~ m/(\d\d\d\d)/ && $1 > 0 ) {
2675 } elsif( $retval =~ m
/
2676 (?
<year
>\d
)[-]?
[.Xx?
]{3}
2677 |(?
<year
>\d
{2})[.Xx?
]{2}
2678 |(?
<year
>\d
{3})[.Xx?
]
2679 |(?
<year
>\d
)[-]{3}\?
2680 |(?
<year
>\d\d
)[-]{2}\?
2681 |(?
<year
>\d
{3})[-]\?
2682 /xms
) { # the form 198-? occurred in Dutch ISBD rules
2683 my $digits = $+{year
};
2684 $retval = $digits * ( 10 ** ( 4 - length($digits) ));
2689 =head2 CountItemsIssued
2691 my $count = CountItemsIssued( $biblionumber );
2695 sub CountItemsIssued
{
2696 my ($biblionumber) = @_;
2697 my $dbh = C4
::Context
->dbh;
2698 my $sth = $dbh->prepare('SELECT COUNT(*) as issuedCount FROM items, issues WHERE items.itemnumber = issues.itemnumber AND items.biblionumber = ?');
2699 $sth->execute($biblionumber);
2700 my $row = $sth->fetchrow_hashref();
2701 return $row->{'issuedCount'};
2706 ModZebra( $biblionumber, $op, $server, $record );
2708 $biblionumber is the biblionumber we want to index
2710 $op is specialUpdate or recordDelete, and is used to know what we want to do
2712 $server is the server that we want to update
2714 $record is the update MARC record if it's available. If it's not supplied
2715 and is needed, it'll be loaded from the database.
2720 ###Accepts a $server variable thus we can use it for biblios authorities or other zebra dbs
2721 my ( $biblionumber, $op, $server, $record ) = @_;
2722 $debug && warn "ModZebra: update requested for: $biblionumber $op $server\n";
2723 if ( C4
::Context
->preference('SearchEngine') eq 'Elasticsearch' ) {
2725 # TODO abstract to a standard API that'll work for whatever
2726 require Koha
::SearchEngine
::Elasticsearch
::Indexer
;
2727 my $indexer = Koha
::SearchEngine
::Elasticsearch
::Indexer
->new(
2729 index => $server eq 'biblioserver'
2730 ?
$Koha::SearchEngine
::BIBLIOS_INDEX
2731 : $Koha::SearchEngine
::AUTHORITIES_INDEX
2734 if ( $op eq 'specialUpdate' ) {
2736 $record = GetMarcBiblio
({
2737 biblionumber
=> $biblionumber,
2738 embed_items
=> 1 });
2740 my $records = [$record];
2741 $indexer->update_index_background( [$biblionumber], [$record] );
2743 elsif ( $op eq 'recordDelete' ) {
2744 $indexer->delete_index_background( [$biblionumber] );
2747 croak
"ModZebra called with unknown operation: $op";
2751 my $dbh = C4
::Context
->dbh;
2753 # true ModZebra commented until indexdata fixes zebraDB crashes (it seems they occur on multiple updates
2755 # replaced by a zebraqueue table, that is filled with ModZebra to run.
2756 # the table is emptied by rebuild_zebra.pl script (using the -z switch)
2757 my $check_sql = "SELECT COUNT(*) FROM zebraqueue
2759 AND biblio_auth_number = ?
2762 my $check_sth = $dbh->prepare_cached($check_sql);
2763 $check_sth->execute( $server, $biblionumber, $op );
2764 my ($count) = $check_sth->fetchrow_array;
2765 $check_sth->finish();
2766 if ( $count == 0 ) {
2767 my $sth = $dbh->prepare("INSERT INTO zebraqueue (biblio_auth_number,server,operation) VALUES(?,?,?)");
2768 $sth->execute( $biblionumber, $server, $op );
2774 =head2 EmbedItemsInMarcBiblio
2776 EmbedItemsInMarcBiblio({
2777 marc_record => $marc,
2778 biblionumber => $biblionumber,
2779 item_numbers => $itemnumbers,
2782 Given a MARC::Record object containing a bib record,
2783 modify it to include the items attached to it as 9XX
2784 per the bib's MARC framework.
2785 if $itemnumbers is defined, only specified itemnumbers are embedded.
2787 If $opac is true, then opac-relevant suppressions are included.
2789 If opac filtering will be done, borcat should be passed to properly
2790 override if necessary.
2794 sub EmbedItemsInMarcBiblio
{
2796 my ($marc, $biblionumber, $itemnumbers, $opac, $borcat);
2797 $marc = $params->{marc_record
};
2799 carp
'EmbedItemsInMarcBiblio: No MARC record passed';
2802 $biblionumber = $params->{biblionumber
};
2803 $itemnumbers = $params->{item_numbers
};
2804 $opac = $params->{opac
};
2805 $borcat = $params->{borcat
} // q{};
2807 $itemnumbers = [] unless defined $itemnumbers;
2809 my $frameworkcode = GetFrameworkCode
($biblionumber);
2810 _strip_item_fields
($marc, $frameworkcode);
2812 # ... and embed the current items
2813 my $dbh = C4
::Context
->dbh;
2814 my $sth = $dbh->prepare("SELECT itemnumber FROM items WHERE biblionumber = ?");
2815 $sth->execute($biblionumber);
2816 my ( $itemtag, $itemsubfield ) = GetMarcFromKohaField
( "items.itemnumber", $frameworkcode );
2818 my @item_fields; # Array holding the actual MARC data for items to be included.
2819 my @items; # Array holding items which are both in the list (sitenumbers)
2820 # and on this biblionumber
2822 # Flag indicating if there is potential hiding.
2823 my $opachiddenitems = $opac
2824 && ( C4
::Context
->preference('OpacHiddenItems') !~ /^\s*$/ );
2827 while ( my ($itemnumber) = $sth->fetchrow_array ) {
2828 next if @
$itemnumbers and not grep { $_ == $itemnumber } @
$itemnumbers;
2830 if ( $opachiddenitems ) {
2831 $item = Koha
::Items
->find($itemnumber);
2832 $item = $item ?
$item->unblessed : undef;
2834 push @items, { itemnumber
=> $itemnumber, item
=> $item };
2836 my @items2pass = map { $_->{item
} } @items;
2839 ? C4
::Items
::GetHiddenItemnumbers
({
2840 items
=> \
@items2pass,
2841 borcat
=> $borcat })
2843 # Convert to a hash for quick searching
2844 my %hiddenitems = map { $_ => 1 } @hiddenitems;
2845 foreach my $itemnumber ( map { $_->{itemnumber
} } @items ) {
2846 next if $hiddenitems{$itemnumber};
2847 my $item_marc = C4
::Items
::GetMarcItem
( $biblionumber, $itemnumber );
2848 push @item_fields, $item_marc->field($itemtag);
2850 $marc->append_fields(@item_fields);
2853 =head1 INTERNAL FUNCTIONS
2855 =head2 _koha_marc_update_bib_ids
2858 _koha_marc_update_bib_ids($record, $frameworkcode, $biblionumber, $biblioitemnumber);
2860 Internal function to add or update biblionumber and biblioitemnumber to
2865 sub _koha_marc_update_bib_ids
{
2866 my ( $record, $frameworkcode, $biblionumber, $biblioitemnumber ) = @_;
2868 my ( $biblio_tag, $biblio_subfield ) = GetMarcFromKohaField
( "biblio.biblionumber", $frameworkcode );
2869 die qq{No biblionumber tag
for framework
"$frameworkcode"} unless $biblio_tag;
2870 my ( $biblioitem_tag, $biblioitem_subfield ) = GetMarcFromKohaField
( "biblioitems.biblioitemnumber", $frameworkcode );
2871 die qq{No biblioitemnumber tag
for framework
"$frameworkcode"} unless $biblioitem_tag;
2873 if ( $biblio_tag < 10 ) {
2874 C4
::Biblio
::UpsertMarcControlField
( $record, $biblio_tag, $biblionumber );
2876 C4
::Biblio
::UpsertMarcSubfield
($record, $biblio_tag, $biblio_subfield, $biblionumber);
2878 if ( $biblioitem_tag < 10 ) {
2879 C4
::Biblio
::UpsertMarcControlField
( $record, $biblioitem_tag, $biblioitemnumber );
2881 C4
::Biblio
::UpsertMarcSubfield
($record, $biblioitem_tag, $biblioitem_subfield, $biblioitemnumber);
2885 =head2 _koha_marc_update_biblioitem_cn_sort
2887 _koha_marc_update_biblioitem_cn_sort($marc, $biblioitem, $frameworkcode);
2889 Given a MARC bib record and the biblioitem hash, update the
2890 subfield that contains a copy of the value of biblioitems.cn_sort.
2894 sub _koha_marc_update_biblioitem_cn_sort
{
2896 my $biblioitem = shift;
2897 my $frameworkcode = shift;
2899 my ( $biblioitem_tag, $biblioitem_subfield ) = GetMarcFromKohaField
( "biblioitems.cn_sort", $frameworkcode );
2900 return unless $biblioitem_tag;
2902 my ($cn_sort) = GetClassSort
( $biblioitem->{'biblioitems.cn_source'}, $biblioitem->{'cn_class'}, $biblioitem->{'cn_item'} );
2904 if ( my $field = $marc->field($biblioitem_tag) ) {
2905 $field->delete_subfield( code
=> $biblioitem_subfield );
2906 if ( $cn_sort ne '' ) {
2907 $field->add_subfields( $biblioitem_subfield => $cn_sort );
2911 # if we get here, no biblioitem tag is present in the MARC record, so
2912 # we'll create it if $cn_sort is not empty -- this would be
2913 # an odd combination of events, however
2915 $marc->insert_grouped_field( MARC
::Field
->new( $biblioitem_tag, ' ', ' ', $biblioitem_subfield => $cn_sort ) );
2920 =head2 _koha_add_biblio
2922 my ($biblionumber,$error) = _koha_add_biblio($dbh,$biblioitem);
2924 Internal function to add a biblio ($biblio is a hash with the values)
2928 sub _koha_add_biblio
{
2929 my ( $dbh, $biblio, $frameworkcode ) = @_;
2933 # set the series flag
2934 unless (defined $biblio->{'serial'}){
2935 $biblio->{'serial'} = 0;
2936 if ( $biblio->{'seriestitle'} ) { $biblio->{'serial'} = 1 }
2939 my $query = "INSERT INTO biblio
2940 SET frameworkcode = ?,
2951 my $sth = $dbh->prepare($query);
2953 $frameworkcode, $biblio->{'author'}, $biblio->{'title'}, $biblio->{'unititle'}, $biblio->{'notes'},
2954 $biblio->{'serial'}, $biblio->{'seriestitle'}, $biblio->{'copyrightdate'}, $biblio->{'abstract'}
2957 my $biblionumber = $dbh->{'mysql_insertid'};
2958 if ( $dbh->errstr ) {
2959 $error .= "ERROR in _koha_add_biblio $query" . $dbh->errstr;
2965 #warn "LEAVING _koha_add_biblio: ".$biblionumber."\n";
2966 return ( $biblionumber, $error );
2969 =head2 _koha_modify_biblio
2971 my ($biblionumber,$error) == _koha_modify_biblio($dbh,$biblio,$frameworkcode);
2973 Internal function for updating the biblio table
2977 sub _koha_modify_biblio
{
2978 my ( $dbh, $biblio, $frameworkcode ) = @_;
2983 SET frameworkcode = ?,
2992 WHERE biblionumber = ?
2995 my $sth = $dbh->prepare($query);
2998 $frameworkcode, $biblio->{'author'}, $biblio->{'title'}, $biblio->{'unititle'}, $biblio->{'notes'},
2999 $biblio->{'serial'}, $biblio->{'seriestitle'}, $biblio->{'copyrightdate'} ?
int($biblio->{'copyrightdate'}) : undef, $biblio->{'abstract'}, $biblio->{'biblionumber'}
3000 ) if $biblio->{'biblionumber'};
3002 if ( $dbh->errstr || !$biblio->{'biblionumber'} ) {
3003 $error .= "ERROR in _koha_modify_biblio $query" . $dbh->errstr;
3006 return ( $biblio->{'biblionumber'}, $error );
3009 =head2 _koha_modify_biblioitem_nonmarc
3011 my ($biblioitemnumber,$error) = _koha_modify_biblioitem_nonmarc( $dbh, $biblioitem );
3015 sub _koha_modify_biblioitem_nonmarc
{
3016 my ( $dbh, $biblioitem ) = @_;
3019 # re-calculate the cn_sort, it may have changed
3020 my ($cn_sort) = GetClassSort
( $biblioitem->{'biblioitems.cn_source'}, $biblioitem->{'cn_class'}, $biblioitem->{'cn_item'} );
3022 my $query = "UPDATE biblioitems
3023 SET biblionumber = ?,
3029 publicationyear = ?,
3033 collectiontitle = ?,
3035 collectionvolume= ?,
3036 editionstatement= ?,
3037 editionresponsibility = ?,
3053 where biblioitemnumber = ?
3055 my $sth = $dbh->prepare($query);
3057 $biblioitem->{'biblionumber'}, $biblioitem->{'volume'}, $biblioitem->{'number'}, $biblioitem->{'itemtype'},
3058 $biblioitem->{'isbn'}, $biblioitem->{'issn'}, $biblioitem->{'publicationyear'}, $biblioitem->{'publishercode'},
3059 $biblioitem->{'volumedate'}, $biblioitem->{'volumedesc'}, $biblioitem->{'collectiontitle'}, $biblioitem->{'collectionissn'},
3060 $biblioitem->{'collectionvolume'}, $biblioitem->{'editionstatement'}, $biblioitem->{'editionresponsibility'}, $biblioitem->{'illus'},
3061 $biblioitem->{'pages'}, $biblioitem->{'bnotes'}, $biblioitem->{'size'}, $biblioitem->{'place'},
3062 $biblioitem->{'lccn'}, $biblioitem->{'url'}, $biblioitem->{'biblioitems.cn_source'}, $biblioitem->{'cn_class'},
3063 $biblioitem->{'cn_item'}, $biblioitem->{'cn_suffix'}, $cn_sort, $biblioitem->{'totalissues'},
3064 $biblioitem->{'ean'}, $biblioitem->{'agerestriction'}, $biblioitem->{'biblioitemnumber'}
3066 if ( $dbh->errstr ) {
3067 $error .= "ERROR in _koha_modify_biblioitem_nonmarc $query" . $dbh->errstr;
3070 return ( $biblioitem->{'biblioitemnumber'}, $error );
3073 =head2 _koha_add_biblioitem
3075 my ($biblioitemnumber,$error) = _koha_add_biblioitem( $dbh, $biblioitem );
3077 Internal function to add a biblioitem
3081 sub _koha_add_biblioitem
{
3082 my ( $dbh, $biblioitem ) = @_;
3085 my ($cn_sort) = GetClassSort
( $biblioitem->{'biblioitems.cn_source'}, $biblioitem->{'cn_class'}, $biblioitem->{'cn_item'} );
3086 my $query = "INSERT INTO biblioitems SET
3093 publicationyear = ?,
3097 collectiontitle = ?,
3099 collectionvolume= ?,
3100 editionstatement= ?,
3101 editionresponsibility = ?,
3118 my $sth = $dbh->prepare($query);
3120 $biblioitem->{'biblionumber'}, $biblioitem->{'volume'}, $biblioitem->{'number'}, $biblioitem->{'itemtype'},
3121 $biblioitem->{'isbn'}, $biblioitem->{'issn'}, $biblioitem->{'publicationyear'}, $biblioitem->{'publishercode'},
3122 $biblioitem->{'volumedate'}, $biblioitem->{'volumedesc'}, $biblioitem->{'collectiontitle'}, $biblioitem->{'collectionissn'},
3123 $biblioitem->{'collectionvolume'}, $biblioitem->{'editionstatement'}, $biblioitem->{'editionresponsibility'}, $biblioitem->{'illus'},
3124 $biblioitem->{'pages'}, $biblioitem->{'bnotes'}, $biblioitem->{'size'}, $biblioitem->{'place'},
3125 $biblioitem->{'lccn'}, $biblioitem->{'url'}, $biblioitem->{'biblioitems.cn_source'},
3126 $biblioitem->{'cn_class'}, $biblioitem->{'cn_item'}, $biblioitem->{'cn_suffix'}, $cn_sort,
3127 $biblioitem->{'totalissues'}, $biblioitem->{'ean'}, $biblioitem->{'agerestriction'}
3129 my $bibitemnum = $dbh->{'mysql_insertid'};
3131 if ( $dbh->errstr ) {
3132 $error .= "ERROR in _koha_add_biblioitem $query" . $dbh->errstr;
3136 return ( $bibitemnum, $error );
3139 =head2 _koha_delete_biblio
3141 $error = _koha_delete_biblio($dbh,$biblionumber);
3143 Internal sub for deleting from biblio table -- also saves to deletedbiblio
3145 C<$dbh> - the database handle
3147 C<$biblionumber> - the biblionumber of the biblio to be deleted
3151 # FIXME: add error handling
3153 sub _koha_delete_biblio
{
3154 my ( $dbh, $biblionumber ) = @_;
3156 # get all the data for this biblio
3157 my $sth = $dbh->prepare("SELECT * FROM biblio WHERE biblionumber=?");
3158 $sth->execute($biblionumber);
3160 # FIXME There is a transaction in _koha_delete_biblio_metadata
3161 # But actually all the following should be done inside a single transaction
3162 if ( my $data = $sth->fetchrow_hashref ) {
3164 # save the record in deletedbiblio
3165 # find the fields to save
3166 my $query = "INSERT INTO deletedbiblio SET ";
3168 foreach my $temp ( keys %$data ) {
3169 $query .= "$temp = ?,";
3170 push( @bind, $data->{$temp} );
3173 # replace the last , by ",?)"
3175 my $bkup_sth = $dbh->prepare($query);
3176 $bkup_sth->execute(@bind);
3179 _koha_delete_biblio_metadata
( $biblionumber );
3182 my $sth2 = $dbh->prepare("DELETE FROM biblio WHERE biblionumber=?");
3183 $sth2->execute($biblionumber);
3184 # update the timestamp (Bugzilla 7146)
3185 $sth2= $dbh->prepare("UPDATE deletedbiblio SET timestamp=NOW() WHERE biblionumber=?");
3186 $sth2->execute($biblionumber);
3193 =head2 _koha_delete_biblioitems
3195 $error = _koha_delete_biblioitems($dbh,$biblioitemnumber);
3197 Internal sub for deleting from biblioitems table -- also saves to deletedbiblioitems
3199 C<$dbh> - the database handle
3200 C<$biblionumber> - the biblioitemnumber of the biblioitem to be deleted
3204 # FIXME: add error handling
3206 sub _koha_delete_biblioitems
{
3207 my ( $dbh, $biblioitemnumber ) = @_;
3209 # get all the data for this biblioitem
3210 my $sth = $dbh->prepare("SELECT * FROM biblioitems WHERE biblioitemnumber=?");
3211 $sth->execute($biblioitemnumber);
3213 if ( my $data = $sth->fetchrow_hashref ) {
3215 # save the record in deletedbiblioitems
3216 # find the fields to save
3217 my $query = "INSERT INTO deletedbiblioitems SET ";
3219 foreach my $temp ( keys %$data ) {
3220 $query .= "$temp = ?,";
3221 push( @bind, $data->{$temp} );
3224 # replace the last , by ",?)"
3226 my $bkup_sth = $dbh->prepare($query);
3227 $bkup_sth->execute(@bind);
3230 # delete the biblioitem
3231 my $sth2 = $dbh->prepare("DELETE FROM biblioitems WHERE biblioitemnumber=?");
3232 $sth2->execute($biblioitemnumber);
3233 # update the timestamp (Bugzilla 7146)
3234 $sth2= $dbh->prepare("UPDATE deletedbiblioitems SET timestamp=NOW() WHERE biblioitemnumber=?");
3235 $sth2->execute($biblioitemnumber);
3242 =head2 _koha_delete_biblio_metadata
3244 $error = _koha_delete_biblio_metadata($biblionumber);
3246 C<$biblionumber> - the biblionumber of the biblio metadata to be deleted
3250 sub _koha_delete_biblio_metadata
{
3251 my ($biblionumber) = @_;
3253 my $dbh = C4
::Context
->dbh;
3254 my $schema = Koha
::Database
->new->schema;
3258 INSERT INTO deletedbiblio_metadata
(biblionumber
, format
, `schema`, metadata
)
3259 SELECT biblionumber
, format
, `schema`, metadata FROM biblio_metadata WHERE biblionumber
=?
3260 |, undef, $biblionumber );
3261 $dbh->do( q
|DELETE FROM biblio_metadata WHERE biblionumber
=?
|,
3262 undef, $biblionumber );
3267 =head1 UNEXPORTED FUNCTIONS
3269 =head2 ModBiblioMarc
3271 &ModBiblioMarc($newrec,$biblionumber,$frameworkcode);
3273 Add MARC XML data for a biblio to koha
3275 Function exported, but should NOT be used, unless you really know what you're doing
3280 # pass the MARC::Record to this function, and it will create the records in
3282 my ( $record, $biblionumber, $frameworkcode ) = @_;
3284 carp
'ModBiblioMarc passed an undefined record';
3288 # Clone record as it gets modified
3289 $record = $record->clone();
3290 my $dbh = C4
::Context
->dbh;
3291 my @fields = $record->fields();
3292 if ( !$frameworkcode ) {
3293 $frameworkcode = "";
3295 my $sth = $dbh->prepare("UPDATE biblio SET frameworkcode=? WHERE biblionumber=?");
3296 $sth->execute( $frameworkcode, $biblionumber );
3298 my $encoding = C4
::Context
->preference("marcflavour");
3300 # deal with UNIMARC field 100 (encoding) : create it if needed & set encoding to unicode
3301 if ( $encoding eq "UNIMARC" ) {
3302 my $defaultlanguage = C4
::Context
->preference("UNIMARCField100Language");
3303 $defaultlanguage = "fre" if (!$defaultlanguage || length($defaultlanguage) != 3);
3304 my $string = $record->subfield( 100, "a" );
3305 if ( ($string) && ( length( $record->subfield( 100, "a" ) ) == 36 ) ) {
3306 my $f100 = $record->field(100);
3307 $record->delete_field($f100);
3309 $string = POSIX
::strftime
( "%Y%m%d", localtime );
3311 $string = sprintf( "%-*s", 35, $string );
3312 substr ( $string, 22, 3, $defaultlanguage);
3314 substr( $string, 25, 3, "y50" );
3315 unless ( $record->subfield( 100, "a" ) ) {
3316 $record->insert_fields_ordered( MARC
::Field
->new( 100, "", "", "a" => $string ) );
3320 #enhancement 5374: update transaction date (005) for marc21/unimarc
3321 if($encoding =~ /MARC21|UNIMARC/) {
3322 my @a= (localtime) [5,4,3,2,1,0]; $a[0]+=1900; $a[1]++;
3323 # YY MM DD HH MM SS (update year and month)
3324 my $f005= $record->field('005');
3325 $f005->update(sprintf("%4d%02d%02d%02d%02d%04.1f",@a)) if $f005;
3329 biblionumber
=> $biblionumber,
3330 format
=> 'marcxml',
3331 schema
=> C4
::Context
->preference('marcflavour'),
3333 $record->as_usmarc; # Bug 20126/10455 This triggers field length calculation
3335 my $m_rs = Koha
::Biblio
::Metadatas
->find($metadata) //
3336 Koha
::Biblio
::Metadata
->new($metadata);
3338 my $userenv = C4
::Context
->userenv;
3340 my $borrowernumber = $userenv->{number
};
3341 my $borrowername = join ' ', map { $_ // q{} } @
$userenv{qw(firstname surname)};
3342 unless ($m_rs->in_storage) {
3343 Koha
::Util
::MARC
::set_marc_field
($record, C4
::Context
->preference('MarcFieldForCreatorId'), $borrowernumber);
3344 Koha
::Util
::MARC
::set_marc_field
($record, C4
::Context
->preference('MarcFieldForCreatorName'), $borrowername);
3346 Koha
::Util
::MARC
::set_marc_field
($record, C4
::Context
->preference('MarcFieldForModifierId'), $borrowernumber);
3347 Koha
::Util
::MARC
::set_marc_field
($record, C4
::Context
->preference('MarcFieldForModifierName'), $borrowername);
3350 $m_rs->metadata( $record->as_xml_record($encoding) );
3353 ModZebra
( $biblionumber, "specialUpdate", "biblioserver" );
3354 return $biblionumber;
3357 =head2 CountBiblioInOrders
3359 $count = &CountBiblioInOrders( $biblionumber);
3361 This function return count of biblios in orders with $biblionumber
3365 sub CountBiblioInOrders
{
3366 my ($biblionumber) = @_;
3367 my $dbh = C4
::Context
->dbh;
3368 my $query = "SELECT count(*)
3370 WHERE biblionumber=? AND (datecancellationprinted IS NULL OR datecancellationprinted='0000-00-00')";
3371 my $sth = $dbh->prepare($query);
3372 $sth->execute($biblionumber);
3373 my $count = $sth->fetchrow;
3377 =head2 prepare_host_field
3379 $marcfield = prepare_host_field( $hostbiblioitem, $marcflavour );
3380 Generate the host item entry for an analytic child entry
3384 sub prepare_host_field
{
3385 my ( $hostbiblio, $marcflavour ) = @_;
3386 $marcflavour ||= C4
::Context
->preference('marcflavour');
3387 my $host = GetMarcBiblio
({ biblionumber
=> $hostbiblio });
3388 # unfortunately as_string does not 'do the right thing'
3389 # if field returns undef
3393 if ( $marcflavour eq 'MARC21' || $marcflavour eq 'NORMARC' ) {
3394 if ( $field = $host->field('100') || $host->field('110') || $host->field('11') ) {
3395 my $s = $field->as_string('ab');
3400 if ( $field = $host->field('245') ) {
3401 my $s = $field->as_string('a');
3406 if ( $field = $host->field('260') ) {
3407 my $s = $field->as_string('abc');
3412 if ( $field = $host->field('240') ) {
3413 my $s = $field->as_string();
3418 if ( $field = $host->field('022') ) {
3419 my $s = $field->as_string('a');
3424 if ( $field = $host->field('020') ) {
3425 my $s = $field->as_string('a');
3430 if ( $field = $host->field('001') ) {
3431 $sfd{w
} = $field->data(),;
3433 $host_field = MARC
::Field
->new( 773, '0', ' ', %sfd );
3436 elsif ( $marcflavour eq 'UNIMARC' ) {
3438 if ( $field = $host->field('700') || $host->field('710') || $host->field('720') ) {
3439 my $s = $field->as_string('ab');
3445 if ( $field = $host->field('200') ) {
3446 my $s = $field->as_string('a');
3451 #place of publicaton
3452 if ( $field = $host->field('210') ) {
3453 my $s = $field->as_string('a');
3458 #date of publication
3459 if ( $field = $host->field('210') ) {
3460 my $s = $field->as_string('d');
3466 if ( $field = $host->field('205') ) {
3467 my $s = $field->as_string();
3473 if ( $field = $host->field('856') ) {
3474 my $s = $field->as_string('u');
3480 if ( $field = $host->field('011') ) {
3481 my $s = $field->as_string('a');
3487 if ( $field = $host->field('010') ) {
3488 my $s = $field->as_string('a');
3493 if ( $field = $host->field('001') ) {
3494 $sfd{0} = $field->data(),;
3496 $host_field = MARC
::Field
->new( 461, '0', ' ', %sfd );
3503 =head2 UpdateTotalIssues
3505 UpdateTotalIssues($biblionumber, $increase, [$value])
3507 Update the total issue count for a particular bib record.
3511 =item C<$biblionumber> is the biblionumber of the bib to update
3513 =item C<$increase> is the amount to increase (or decrease) the total issues count by
3515 =item C<$value> is the absolute value that total issues count should be set to. If provided, C<$increase> is ignored.
3521 sub UpdateTotalIssues
{
3522 my ($biblionumber, $increase, $value) = @_;
3525 my $record = GetMarcBiblio
({ biblionumber
=> $biblionumber });
3527 carp
"UpdateTotalIssues could not get biblio record";
3530 my $biblio = Koha
::Biblios
->find( $biblionumber );
3532 carp
"UpdateTotalIssues could not get datas of biblio";
3535 my $biblioitem = $biblio->biblioitem;
3536 my ($totalissuestag, $totalissuessubfield) = GetMarcFromKohaField
('biblioitems.totalissues', $biblio->frameworkcode);
3537 unless ($totalissuestag) {
3538 return 1; # There is nothing to do
3541 if (defined $value) {
3542 $totalissues = $value;
3544 $totalissues = $biblioitem->totalissues + $increase;
3547 my $field = $record->field($totalissuestag);
3548 if (defined $field) {
3549 $field->update( $totalissuessubfield => $totalissues );
3551 $field = MARC
::Field
->new($totalissuestag, '0', '0',
3552 $totalissuessubfield => $totalissues);
3553 $record->insert_grouped_field($field);
3556 return ModBiblio
($record, $biblionumber, $biblio->frameworkcode);
3561 &RemoveAllNsb($record);
3563 Removes all nsb/nse chars from a record
3570 carp
'RemoveAllNsb called with undefined record';
3574 SetUTF8Flag
($record);
3576 foreach my $field ($record->fields()) {
3577 if ($field->is_control_field()) {
3578 $field->update(nsb_clean
($field->data()));
3580 my @subfields = $field->subfields();
3582 foreach my $subfield (@subfields) {
3583 push @new_subfields, $subfield->[0] => nsb_clean
($subfield->[1]);
3585 if (scalar(@new_subfields) > 0) {
3588 $new_field = MARC
::Field
->new(
3590 $field->indicator(1),
3591 $field->indicator(2),
3596 warn "error in RemoveAllNsb : $@";
3598 $field->replace_with($new_field);
3614 Koha Development Team <http://koha-community.org/>
3616 Paul POULAIN paul.poulain@free.fr
3618 Joshua Ferraro jmf@liblime.com