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);
48 GetAuthorisedValueDesc
50 IsMarcStructureInternal
52 GetMarcSubfieldStructureFromKohaField
64 LinkBibHeadingsToAuthorities
72 # those functions are exported but should not be used
73 # they are useful in a few circumstances, so they are exported,
74 # but don't use them unless you are a core developer ;-)
83 use Encode
qw( decode is_utf8 );
84 use List
::MoreUtils
qw( uniq );
86 use MARC
::File
::USMARC
;
88 use POSIX
qw(strftime);
89 use Module
::Load
::Conditional
qw(can_load);
92 use C4
::Log
; # logaction
101 use Koha
::Authority
::Types
;
102 use Koha
::Acquisition
::Currencies
;
103 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 _after_biblio_action_hooks({ action => 'create', biblio_id => $biblionumber });
239 logaction( "CATALOGUING", "ADD", $biblionumber, "biblio" ) if C4::Context->preference("CataloguingLog");
240 return ( $biblionumber, $biblioitemnumber );
245 ModBiblio( $record,$biblionumber,$frameworkcode, $disable_autolink);
247 Replace an existing bib record identified by C<$biblionumber>
248 with one supplied by the MARC::Record object C<$record>. The embedded
249 item, biblioitem, and biblionumber fields from the previous
250 version of the bib record replace any such fields of those tags that
251 are present in C<$record>. Consequently, ModBiblio() is not
252 to be used to try to modify item records.
254 C<$frameworkcode> specifies the MARC framework to use
255 when storing the modified bib record; among other things,
256 this controls how MARC fields get mapped to display columns
257 in the C<biblio> and C<biblioitems> tables, as well as
258 which fields are used to store embedded item, biblioitem,
259 and biblionumber data for indexing.
261 Unless C<$disable_autolink> is passed ModBiblio will relink record headings
262 to authorities based on settings in the system preferences. This flag allows
263 us to not relink records when the authority linker is saving modifications.
265 Returns 1 on success 0 on failure
270 my ( $record, $biblionumber, $frameworkcode, $disable_autolink ) = @_;
272 carp 'No record passed to ModBiblio';
276 if ( C4::Context->preference("CataloguingLog") ) {
277 my $newrecord = GetMarcBiblio({ biblionumber => $biblionumber });
278 logaction( "CATALOGUING", "MODIFY", $biblionumber, "biblio BEFORE=>" . $newrecord->as_formatted );
281 if ( !$disable_autolink && C4::Context->preference('BiblioAddsAuthorities') ) {
282 BiblioAutoLink( $record, $frameworkcode );
285 # Cleaning up invalid fields must be done early or SetUTF8Flag is liable to
286 # throw an exception which probably won't be handled.
287 foreach my $field ($record->fields()) {
288 if (! $field->is_control_field()) {
289 if (scalar($field->subfields()) == 0 || (scalar($field->subfields()) == 1 && $field->subfield('9'))) {
290 $record->delete_field($field);
295 SetUTF8Flag($record);
296 my $dbh = C4::Context->dbh;
298 $frameworkcode = "" if !$frameworkcode || $frameworkcode eq "Default"; # XXX
300 _strip_item_fields($record, $frameworkcode);
302 # update biblionumber and biblioitemnumber in MARC
303 # FIXME - this is assuming a 1 to 1 relationship between
304 # biblios and biblioitems
305 my $sth = $dbh->prepare("select biblioitemnumber from biblioitems where biblionumber=?");
306 $sth->execute($biblionumber);
307 my ($biblioitemnumber) = $sth->fetchrow;
309 _koha_marc_update_bib_ids( $record, $frameworkcode, $biblionumber, $biblioitemnumber );
311 # load the koha-table data object
312 my $oldbiblio = TransformMarcToKoha( $record, $frameworkcode );
314 # update MARC subfield that stores biblioitems.cn_sort
315 _koha_marc_update_biblioitem_cn_sort( $record, $oldbiblio, $frameworkcode );
317 # update the MARC record (that now contains biblio and items) with the new record data
318 &ModBiblioMarc( $record, $biblionumber, $frameworkcode );
320 # modify the other koha tables
321 _koha_modify_biblio( $dbh, $oldbiblio, $frameworkcode );
322 _koha_modify_biblioitem_nonmarc( $dbh, $oldbiblio );
324 _after_biblio_action_hooks({ action => 'modify', biblio_id => $biblionumber });
326 # update OAI-PMH sets
327 if(C4::Context->preference("OAI-PMH:AutoUpdateSets")) {
328 C4::OAI::Sets::UpdateOAISetsBiblio($biblionumber, $record);
334 =head2 _strip_item_fields
336 _strip_item_fields($record, $frameworkcode)
338 Utility routine to remove item tags from a
343 sub _strip_item_fields {
345 my $frameworkcode = shift;
346 # get the items before and append them to the biblio before updating the record, atm we just have the biblio
347 my ( $itemtag, $itemsubfield ) = GetMarcFromKohaField( "items.itemnumber" );
349 # delete any item fields from incoming record to avoid
350 # duplication or incorrect data - use AddItem() or ModItem()
352 foreach my $field ( $record->field($itemtag) ) {
353 $record->delete_field($field);
359 my $error = &DelBiblio($biblionumber);
361 Exported function (core API) for deleting a biblio in koha.
362 Deletes biblio record from Zebra and Koha tables (biblio & biblioitems)
363 Also backs it up to deleted* tables.
364 Checks to make sure that the biblio has no items attached.
366 C<$error> : undef unless an error occurs
371 my ($biblionumber) = @_;
373 my $biblio = Koha::Biblios->find( $biblionumber );
374 return unless $biblio; # Should we throw an exception instead?
376 my $dbh = C4::Context->dbh;
377 my $error; # for error handling
379 # First make sure this biblio has no items attached
380 my $sth = $dbh->prepare("SELECT itemnumber FROM items WHERE biblionumber=?");
381 $sth->execute($biblionumber);
382 if ( my $itemnumber = $sth->fetchrow ) {
384 # Fix this to use a status the template can understand
385 $error .= "This Biblio has items attached, please delete them first before deleting this biblio ";
388 return $error if $error;
390 # We delete attached subscriptions
392 my $subscriptions = C4::Serials::GetFullSubscriptionsFromBiblionumber($biblionumber);
393 foreach my $subscription (@$subscriptions) {
394 C4::Serials::DelSubscription( $subscription->{subscriptionid} );
397 # We delete any existing holds
398 my $holds = $biblio->holds;
399 while ( my $hold = $holds->next ) {
403 # Delete in Zebra. Be careful NOT to move this line after _koha_delete_biblio
404 # for at least 2 reasons :
405 # - if something goes wrong, the biblio may be deleted from Koha but not from zebra
406 # 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)
407 ModZebra( $biblionumber, "recordDelete", "biblioserver" );
409 # delete biblioitems and items from Koha tables and save in deletedbiblioitems,deleteditems
410 $sth = $dbh->prepare("SELECT biblioitemnumber FROM biblioitems WHERE biblionumber=?");
411 $sth->execute($biblionumber);
412 while ( my $biblioitemnumber = $sth->fetchrow ) {
414 # delete this biblioitem
415 $error = _koha_delete_biblioitems( $dbh, $biblioitemnumber );
416 return $error if $error;
420 # delete biblio from Koha tables and save in deletedbiblio
421 # must do this *after* _koha_delete_biblioitems, otherwise
422 # delete cascade will prevent deletedbiblioitems rows
423 # from being generated by _koha_delete_biblioitems
424 $error = _koha_delete_biblio( $dbh, $biblionumber );
426 _after_biblio_action_hooks({ action => 'delete', biblio_id => $biblionumber });
428 logaction( "CATALOGUING", "DELETE", $biblionumber, "biblio" ) if C4::Context->preference("CataloguingLog");
434 =head2 BiblioAutoLink
436 my $headings_linked = BiblioAutoLink($record, $frameworkcode)
438 Automatically links headings in a bib record to authorities.
440 Returns the number of headings changed
446 my $frameworkcode = shift;
448 carp('Undefined record passed to BiblioAutoLink');
451 my ( $num_headings_changed, %results );
454 "C4::Linker::" . ( C4::Context->preference("LinkerModule") || 'Default' );
455 unless ( can_load( modules => { $linker_module => undef } ) ) {
456 $linker_module = 'C4::Linker::Default';
457 unless ( can_load( modules => { $linker_module => undef } ) ) {
462 my $linker = $linker_module->new(
463 { 'options' => C4::Context->preference("LinkerOptions") } );
464 my ( $headings_changed, undef ) =
465 LinkBibHeadingsToAuthorities( $linker, $record, $frameworkcode, C4::Context->preference("CatalogModuleRelink") || '' );
466 # By default we probably don't want to relink things when cataloging
467 return $headings_changed;
470 =head2 LinkBibHeadingsToAuthorities
472 my $num_headings_changed, %results = LinkBibHeadingsToAuthorities($linker, $marc, $frameworkcode, [$allowrelink]);
474 Links bib headings to authority records by checking
475 each authority-controlled field in the C<MARC::Record>
476 object C<$marc>, looking for a matching authority record,
477 and setting the linking subfield $9 to the ID of that
480 If $allowrelink is false, existing authids will never be
481 replaced, regardless of the values of LinkerKeepStale and
484 Returns the number of heading links changed in the
489 sub LinkBibHeadingsToAuthorities {
492 my $frameworkcode = shift;
493 my $allowrelink = shift;
496 carp 'LinkBibHeadingsToAuthorities called on undefined bib record';
500 require C4::AuthoritiesMarc;
502 $allowrelink = 1 unless defined $allowrelink;
503 my $num_headings_changed = 0;
504 foreach my $field ( $bib->fields() ) {
505 my $heading = C4::Heading->new_from_field( $field, $frameworkcode );
506 next unless defined $heading;
509 my $current_link = $field->subfield('9');
511 if ( defined $current_link && (!$allowrelink || !C4::Context->preference('LinkerRelink')) )
513 $results{'linked'}->{ $heading->display_form() }++;
517 my ( $authid, $fuzzy ) = $linker->get_link($heading);
519 $results{ $fuzzy ? 'fuzzy' : 'linked' }
520 ->{ $heading->display_form() }++;
521 next if defined $current_link and $current_link == $authid;
523 $field->delete_subfield( code => '9' ) if defined $current_link;
524 $field->add_subfields( '9', $authid );
525 $num_headings_changed++;
528 if ( defined $current_link
529 && (!$allowrelink || C4::Context->preference('LinkerKeepStale')) )
531 $results{'fuzzy'}->{ $heading->display_form() }++;
533 elsif ( C4::Context->preference('AutoCreateAuthorities') ) {
534 if ( _check_valid_auth_link( $current_link, $field ) ) {
535 $results{'linked'}->{ $heading->display_form() }++;
538 my $authority_type = Koha::Authority::Types->find( $heading->auth_type() );
539 my $marcrecordauth = MARC::Record->new();
540 if ( C4::Context->preference('marcflavour') eq 'MARC21' ) {
541 $marcrecordauth->leader(' nz a22 o 4500');
542 SetMarcUnicodeFlag( $marcrecordauth, 'MARC21' );
544 $field->delete_subfield( code => '9' )
545 if defined $current_link;
547 foreach my $subfield ( $field->subfields() ){
548 if ( $subfield->[0] =~ /[A-z]/
549 && C4::Heading::valid_heading_subfield(
550 $field->tag, $subfield->[0] )
552 push @auth_subfields, $subfield->[0] => $subfield->[1];
555 # Bib headings contain some ending punctuation that should NOT
556 # be included in the authority record. Strip those before creation
557 next unless @auth_subfields; # Don't try to create a record if we have no fields;
558 my $last_sub = pop @auth_subfields;
559 $last_sub =~ s/[\s]*[,.:=;!%\/][\s]*$//;
560 push @auth_subfields, $last_sub;
561 my $authfield = MARC::Field->new( $authority_type->auth_tag_to_report, '', '', @auth_subfields );
562 $marcrecordauth->insert_fields_ordered($authfield);
564 # bug 2317: ensure new authority knows it's using UTF-8; currently
565 # only need to do this for MARC21, as MARC::Record->as_xml_record() handles
566 # automatically for UNIMARC (by not transcoding)
567 # FIXME: AddAuthority() instead should simply explicitly require that the MARC::Record
568 # use UTF-8, but as of 2008-08-05, did not want to introduce that kind
569 # of change to a core API just before the 3.0 release.
571 if ( C4::Context->preference('marcflavour') eq 'MARC21' ) {
572 my $userenv = C4::Context->userenv;
574 if ( $userenv && $userenv->{'branch'} ) {
575 $library = Koha::Libraries->find( $userenv->{'branch'} );
577 $marcrecordauth->insert_fields_ordered(
580 'a' => "Machine generated authority record."
584 $bib->author() . ", "
585 . $bib->title_proper() . ", "
586 . $bib->publication_date() . " ";
587 $cite =~ s/^[\s\,]*//;
588 $cite =~ s/[\s\,]*$//;
591 . ( $library ? $library->get_effective_marcorgcode : C4::Context->preference('MARCOrgCode') ) . ")"
592 . $bib->subfield( '999', 'c' ) . ": "
594 $marcrecordauth->insert_fields_ordered(
595 MARC::Field->new( '670', '', '', 'a' => $cite ) );
598 # warn "AUTH RECORD ADDED : ".$marcrecordauth->as_formatted;
601 C4::AuthoritiesMarc::AddAuthority( $marcrecordauth, '',
602 $heading->auth_type() );
603 $field->add_subfields( '9', $authid );
604 $num_headings_changed++;
605 $linker->update_cache($heading, $authid);
606 $results{'added'}->{ $heading->display_form() }++;
609 elsif ( defined $current_link ) {
610 if ( _check_valid_auth_link( $current_link, $field ) ) {
611 $results{'linked'}->{ $heading->display_form() }++;
614 $field->delete_subfield( code => '9' );
615 $num_headings_changed++;
616 $results{'unlinked'}->{ $heading->display_form() }++;
620 $results{'unlinked'}->{ $heading->display_form() }++;
625 return $num_headings_changed, \%results;
628 =head2 _check_valid_auth_link
630 if ( _check_valid_auth_link($authid, $field) ) {
634 Check whether the specified heading-auth link is valid without reference
635 to Zebra. Ideally this code would be in C4::Heading, but that won't be
636 possible until we have de-cycled C4::AuthoritiesMarc, so this is the
641 sub _check_valid_auth_link {
642 my ( $authid, $field ) = @_;
643 require C4::AuthoritiesMarc;
645 my $authorized_heading =
646 C4::AuthoritiesMarc::GetAuthorizedHeading( { 'authid' => $authid } ) || '';
647 return ($field->as_string('abcdefghijklmnopqrstuvwxyz') eq $authorized_heading);
652 $data = &GetBiblioData($biblionumber);
654 Returns information about the book with the given biblionumber.
655 C<&GetBiblioData> returns a reference-to-hash. The keys are the fields in
656 the C<biblio> and C<biblioitems> tables in the
659 In addition, C<$data-E<gt>{subject}> is the list of the book's
660 subjects, separated by C<" , "> (space, comma, space).
661 If there are multiple biblioitems with the given biblionumber, only
662 the first one is considered.
668 my $dbh = C4::Context->dbh;
670 my $query = " SELECT * , biblioitems.notes AS bnotes, itemtypes.notforloan as bi_notforloan, biblio.notes
672 LEFT JOIN biblioitems ON biblio.biblionumber = biblioitems.biblionumber
673 LEFT JOIN itemtypes ON biblioitems.itemtype = itemtypes.itemtype
674 WHERE biblio.biblionumber = ?";
676 my $sth = $dbh->prepare($query);
677 $sth->execute($bibnum);
679 $data = $sth->fetchrow_hashref;
683 } # sub GetBiblioData
687 $isbd = &GetISBDView({
688 'record' => $marc_record,
689 'template' => $interface, # opac/intranet
690 'framework' => $framework,
693 Return the ISBD view which can be included in opac and intranet
700 # Expecting record WITH items.
701 my $record = $params->{record};
702 return unless defined $record;
704 my $template = $params->{template} // q{};
705 my $sysprefname = $template eq 'opac' ?
'opacisbd' : 'isbd';
706 my $framework = $params->{framework
};
707 my $itemtype = $framework;
708 my ( $holdingbrtagf, $holdingbrtagsubf ) = &GetMarcFromKohaField
( "items.holdingbranch" );
709 my $tagslib = GetMarcStructure
( 1, $itemtype, { unsafe
=> 1 } );
711 my $ISBD = C4
::Context
->preference($sysprefname);
716 foreach my $isbdfield ( split( /#/, $bloc ) ) {
718 # $isbdfield= /(.?.?.?)/;
719 $isbdfield =~ /(\d\d\d)([^\|])?\|(.*)\|(.*)\|(.*)/;
720 my $fieldvalue = $1 || 0;
721 my $subfvalue = $2 || "";
723 my $analysestring = $4;
726 # warn "==> $1 / $2 / $3 / $4";
727 # my $fieldvalue=substr($isbdfield,0,3);
728 if ( $fieldvalue > 0 ) {
729 my $hasputtextbefore = 0;
730 my @fieldslist = $record->field($fieldvalue);
731 @fieldslist = sort { $a->subfield($holdingbrtagsubf) cmp $b->subfield($holdingbrtagsubf) } @fieldslist if ( $fieldvalue eq $holdingbrtagf );
733 # warn "ERROR IN ISBD DEFINITION at : $isbdfield" unless $fieldvalue;
734 # warn "FV : $fieldvalue";
735 if ( $subfvalue ne "" ) {
736 # OPAC hidden subfield
738 if ( ( $template eq 'opac' )
739 && ( $tagslib->{$fieldvalue}->{$subfvalue}->{'hidden'} || 0 ) > 0 );
740 foreach my $field (@fieldslist) {
741 foreach my $subfield ( $field->subfield($subfvalue) ) {
742 my $calculated = $analysestring;
743 my $tag = $field->tag();
746 my $subfieldvalue = GetAuthorisedValueDesc
( $tag, $subfvalue, $subfield, '', $tagslib );
747 my $tagsubf = $tag . $subfvalue;
748 $calculated =~ s/\{(.?.?.?.?)$tagsubf(.*?)\}/$1$subfieldvalue$2\{$1$tagsubf$2\}/g;
749 if ( $template eq "opac" ) { $calculated =~ s
#/cgi-bin/koha/[^/]+/([^.]*.pl\?.*)$#opac-$1#g; }
751 # field builded, store the result
752 if ( $calculated && !$hasputtextbefore ) { # put textbefore if not done
753 $blocres .= $textbefore;
754 $hasputtextbefore = 1;
757 # remove punctuation at start
758 $calculated =~ s/^( |;|:|\.|-)*//g;
759 $blocres .= $calculated;
764 $blocres .= $textafter if $hasputtextbefore;
766 foreach my $field (@fieldslist) {
767 my $calculated = $analysestring;
768 my $tag = $field->tag();
771 my @subf = $field->subfields;
772 for my $i ( 0 .. $#subf ) {
773 my $valuecode = $subf[$i][1];
774 my $subfieldcode = $subf[$i][0];
775 # OPAC hidden subfield
777 if ( ( $template eq 'opac' )
778 && ( $tagslib->{$fieldvalue}->{$subfieldcode}->{'hidden'} || 0 ) > 0 );
779 my $subfieldvalue = GetAuthorisedValueDesc
( $tag, $subf[$i][0], $subf[$i][1], '', $tagslib );
780 my $tagsubf = $tag . $subfieldcode;
782 $calculated =~ s
/ # replace all {{}} codes by the value code.
783 \
{\
{$tagsubf\
}\
} # catch the {{actualcode}}
785 $valuecode # replace by the value code
788 $calculated =~ s/\{(.?.?.?.?)$tagsubf(.*?)\}/$1$subfieldvalue$2\{$1$tagsubf$2\}/g;
789 if ( $template eq "opac" ) { $calculated =~ s
#/cgi-bin/koha/[^/]+/([^.]*.pl\?.*)$#opac-$1#g; }
792 # field builded, store the result
793 if ( $calculated && !$hasputtextbefore ) { # put textbefore if not done
794 $blocres .= $textbefore;
795 $hasputtextbefore = 1;
798 # remove punctuation at start
799 $calculated =~ s/^( |;|:|\.|-)*//g;
800 $blocres .= $calculated;
803 $blocres .= $textafter if $hasputtextbefore;
806 $blocres .= $isbdfield;
811 $res =~ s/\{(.*?)\}//g;
813 $res =~ s/\n/<br\/>/g
;
821 =head1 FUNCTIONS FOR HANDLING MARC MANAGEMENT
823 =head2 IsMarcStructureInternal
825 my $tagslib = C4::Biblio::GetMarcStructure();
826 for my $tag ( sort keys %$tagslib ) {
828 for my $subfield ( sort keys %{ $tagslib->{$tag} } ) {
829 next if IsMarcStructureInternal($tagslib->{$tag}{$subfield});
834 GetMarcStructure creates keys (lib, tab, mandatory, repeatable) for a display purpose.
835 These different values should not be processed as valid subfields.
839 sub IsMarcStructureInternal
{
840 my ( $subfield ) = @_;
841 return ref $subfield ?
0 : 1;
844 =head2 GetMarcStructure
846 $res = GetMarcStructure($forlibrarian, $frameworkcode, [ $params ]);
848 Returns a reference to a big hash of hash, with the Marc structure for the given frameworkcode
849 $forlibrarian :if set to 1, the MARC descriptions are the librarians ones, otherwise it's the public (OPAC) ones
850 $frameworkcode : the framework code to read
851 $params allows you to pass { unsafe => 1 } for better performance.
853 Note: If you call GetMarcStructure with unsafe => 1, do not modify or
854 even autovivify its contents. It is a cached/shared data structure. Your
855 changes c/would be passed around in subsequent calls.
859 sub GetMarcStructure
{
860 my ( $forlibrarian, $frameworkcode, $params ) = @_;
861 $frameworkcode = "" unless $frameworkcode;
863 $forlibrarian = $forlibrarian ?
1 : 0;
864 my $unsafe = ($params && $params->{unsafe
})?
1: 0;
865 my $cache = Koha
::Caches
->get_instance();
866 my $cache_key = "MarcStructure-$forlibrarian-$frameworkcode";
867 my $cached = $cache->get_from_cache($cache_key, { unsafe
=> $unsafe });
868 return $cached if $cached;
870 my $dbh = C4
::Context
->dbh;
871 my $sth = $dbh->prepare(
872 "SELECT tagfield,liblibrarian,libopac,mandatory,repeatable,ind1_defaultvalue,ind2_defaultvalue
873 FROM marc_tag_structure
874 WHERE frameworkcode=?
877 $sth->execute($frameworkcode);
878 my ( $liblibrarian, $libopac, $tag, $res, $tab, $mandatory, $repeatable, $ind1_defaultvalue, $ind2_defaultvalue );
880 while ( ( $tag, $liblibrarian, $libopac, $mandatory, $repeatable, $ind1_defaultvalue, $ind2_defaultvalue ) = $sth->fetchrow ) {
881 $res->{$tag}->{lib
} = ( $forlibrarian or !$libopac ) ?
$liblibrarian : $libopac;
882 $res->{$tag}->{tab
} = "";
883 $res->{$tag}->{mandatory
} = $mandatory;
884 $res->{$tag}->{repeatable
} = $repeatable;
885 $res->{$tag}->{ind1_defaultvalue
} = $ind1_defaultvalue;
886 $res->{$tag}->{ind2_defaultvalue
} = $ind2_defaultvalue;
889 $sth = $dbh->prepare(
890 "SELECT tagfield,tagsubfield,liblibrarian,libopac,tab,mandatory,repeatable,authorised_value,authtypecode,value_builder,kohafield,seealso,hidden,isurl,link,defaultvalue,maxlength
891 FROM marc_subfield_structure
892 WHERE frameworkcode=?
893 ORDER BY tagfield,tagsubfield
897 $sth->execute($frameworkcode);
900 my $authorised_value;
912 ( $tag, $subfield, $liblibrarian, $libopac, $tab, $mandatory, $repeatable, $authorised_value,
913 $authtypecode, $value_builder, $kohafield, $seealso, $hidden, $isurl, $link, $defaultvalue,
918 $res->{$tag}->{$subfield}->{lib
} = ( $forlibrarian or !$libopac ) ?
$liblibrarian : $libopac;
919 $res->{$tag}->{$subfield}->{tab
} = $tab;
920 $res->{$tag}->{$subfield}->{mandatory
} = $mandatory;
921 $res->{$tag}->{$subfield}->{repeatable
} = $repeatable;
922 $res->{$tag}->{$subfield}->{authorised_value
} = $authorised_value;
923 $res->{$tag}->{$subfield}->{authtypecode
} = $authtypecode;
924 $res->{$tag}->{$subfield}->{value_builder
} = $value_builder;
925 $res->{$tag}->{$subfield}->{kohafield
} = $kohafield;
926 $res->{$tag}->{$subfield}->{seealso
} = $seealso;
927 $res->{$tag}->{$subfield}->{hidden
} = $hidden;
928 $res->{$tag}->{$subfield}->{isurl
} = $isurl;
929 $res->{$tag}->{$subfield}->{'link'} = $link;
930 $res->{$tag}->{$subfield}->{defaultvalue
} = $defaultvalue;
931 $res->{$tag}->{$subfield}->{maxlength
} = $maxlength;
934 $cache->set_in_cache($cache_key, $res);
938 =head2 GetUsedMarcStructure
940 The same function as GetMarcStructure except it just takes field
941 in tab 0-9. (used field)
943 my $results = GetUsedMarcStructure($frameworkcode);
945 C<$results> is a ref to an array which each case contains a ref
946 to a hash which each keys is the columns from marc_subfield_structure
948 C<$frameworkcode> is the framework code.
952 sub GetUsedMarcStructure
{
953 my $frameworkcode = shift || '';
956 FROM marc_subfield_structure
958 AND frameworkcode = ?
959 ORDER BY tagfield, tagsubfield
961 my $sth = C4
::Context
->dbh->prepare($query);
962 $sth->execute($frameworkcode);
963 return $sth->fetchall_arrayref( {} );
968 =head2 GetMarcSubfieldStructure
970 my $structure = GetMarcSubfieldStructure($frameworkcode, [$params]);
972 Returns a reference to hash representing MARC subfield structure
973 for framework with framework code C<$frameworkcode>, C<$params> is
974 optional and may contain additional options.
978 =item C<$frameworkcode>
984 An optional hash reference with additional options.
985 The following options are supported:
991 Pass { unsafe => 1 } do disable cached object cloning,
992 and instead get a shared reference, resulting in better
993 performance (but care must be taken so that retured object
996 Note: If you call GetMarcSubfieldStructure with unsafe => 1, do not modify or
997 even autovivify its contents. It is a cached/shared data structure. Your
998 changes would be passed around in subsequent calls.
1006 sub GetMarcSubfieldStructure
{
1007 my ( $frameworkcode, $params ) = @_;
1009 $frameworkcode //= '';
1011 my $cache = Koha
::Caches
->get_instance();
1012 my $cache_key = "MarcSubfieldStructure-$frameworkcode";
1013 my $cached = $cache->get_from_cache($cache_key, { unsafe
=> ($params && $params->{unsafe
}) });
1014 return $cached if $cached;
1016 my $dbh = C4
::Context
->dbh;
1017 # We moved to selectall_arrayref since selectall_hashref does not
1018 # keep duplicate mappings on kohafield (like place in 260 vs 264)
1019 my $subfield_aref = $dbh->selectall_arrayref( q
|
1021 FROM marc_subfield_structure
1022 WHERE frameworkcode
= ?
1024 ORDER BY frameworkcode
,tagfield
,tagsubfield
1025 |, { Slice
=> {} }, $frameworkcode );
1026 # Now map the output to a hash structure
1027 my $subfield_structure = {};
1028 foreach my $row ( @
$subfield_aref ) {
1029 push @
{ $subfield_structure->{ $row->{kohafield
} }}, $row;
1031 $cache->set_in_cache( $cache_key, $subfield_structure );
1032 return $subfield_structure;
1035 =head2 GetMarcFromKohaField
1037 ( $field,$subfield ) = GetMarcFromKohaField( $kohafield );
1038 @fields = GetMarcFromKohaField( $kohafield );
1039 $field = GetMarcFromKohaField( $kohafield );
1041 Returns the MARC fields & subfields mapped to $kohafield.
1042 Since the Default framework is considered as authoritative for such
1043 mappings, the former frameworkcode parameter is obsoleted.
1045 In list context all mappings are returned; there can be multiple
1046 mappings. Note that in the above example you could miss a second
1047 mappings in the first call.
1048 In scalar context only the field tag of the first mapping is returned.
1052 sub GetMarcFromKohaField
{
1053 my ( $kohafield ) = @_;
1054 return unless $kohafield;
1055 # The next call uses the Default framework since it is AUTHORITATIVE
1056 # for all Koha to MARC mappings.
1057 my $mss = GetMarcSubfieldStructure
( '', { unsafe
=> 1 } ); # Do not change framework
1059 foreach( @
{ $mss->{$kohafield} } ) {
1060 push @retval, $_->{tagfield
}, $_->{tagsubfield
};
1062 return wantarray ?
@retval : ( @retval ?
$retval[0] : undef );
1065 =head2 GetMarcSubfieldStructureFromKohaField
1067 my $str = GetMarcSubfieldStructureFromKohaField( $kohafield );
1069 Returns marc subfield structure information for $kohafield.
1070 The Default framework is used, since it is authoritative for kohafield
1072 In list context returns a list of all hashrefs, since there may be
1073 multiple mappings. In scalar context the first hashref is returned.
1077 sub GetMarcSubfieldStructureFromKohaField
{
1078 my ( $kohafield ) = @_;
1080 return unless $kohafield;
1082 # The next call uses the Default framework since it is AUTHORITATIVE
1083 # for all Koha to MARC mappings.
1084 my $mss = GetMarcSubfieldStructure
( '', { unsafe
=> 1 } ); # Do not change framework
1085 return unless $mss->{$kohafield};
1086 return wantarray ? @
{$mss->{$kohafield}} : $mss->{$kohafield}->[0];
1089 =head2 GetMarcBiblio
1091 my $record = GetMarcBiblio({
1092 biblionumber => $biblionumber,
1093 embed_items => $embeditems,
1095 borcat => $patron_category });
1097 Returns MARC::Record representing a biblio record, or C<undef> if the
1098 biblionumber doesn't exist.
1100 Both embed_items and opac are optional.
1101 If embed_items is passed and is 1, items are embedded.
1102 If opac is passed and is 1, the record is filtered as needed.
1106 =item C<$biblionumber>
1110 =item C<$embeditems>
1112 set to true to include item information.
1116 set to true to make the result suited for OPAC view. This causes things like
1117 OpacHiddenItems to be applied.
1121 If the OpacHiddenItemsExceptions system preference is set, this patron category
1122 can be used to make visible OPAC items which would be normally hidden.
1123 It only makes sense in combination both embed_items and opac values true.
1132 if (not defined $params) {
1133 carp
'GetMarcBiblio called without parameters';
1137 my $biblionumber = $params->{biblionumber
};
1138 my $embeditems = $params->{embed_items
} || 0;
1139 my $opac = $params->{opac
} || 0;
1140 my $borcat = $params->{borcat
} // q{};
1142 if (not defined $biblionumber) {
1143 carp
'GetMarcBiblio called with undefined biblionumber';
1147 my $dbh = C4
::Context
->dbh;
1148 my $sth = $dbh->prepare("SELECT biblioitemnumber FROM biblioitems WHERE biblionumber=? ");
1149 $sth->execute($biblionumber);
1150 my $row = $sth->fetchrow_hashref;
1151 my $biblioitemnumber = $row->{'biblioitemnumber'};
1152 my $marcxml = GetXmlBiblio
( $biblionumber );
1153 $marcxml = StripNonXmlChars
( $marcxml );
1154 my $frameworkcode = GetFrameworkCode
($biblionumber);
1155 MARC
::File
::XML
->default_record_format( C4
::Context
->preference('marcflavour') );
1156 my $record = MARC
::Record
->new();
1160 MARC
::Record
::new_from_xml
( $marcxml, "UTF-8",
1161 C4
::Context
->preference('marcflavour') );
1163 if ($@
) { warn " problem with :$biblionumber : $@ \n$marcxml"; }
1164 return unless $record;
1166 C4
::Biblio
::_koha_marc_update_bib_ids
( $record, $frameworkcode, $biblionumber,
1167 $biblioitemnumber );
1168 C4
::Biblio
::EmbedItemsInMarcBiblio
({
1169 marc_record
=> $record,
1170 biblionumber
=> $biblionumber,
1172 borcat
=> $borcat })
1184 my $marcxml = GetXmlBiblio($biblionumber);
1186 Returns biblio_metadata.metadata/marcxml of the biblionumber passed in parameter.
1187 The XML should only contain biblio information (item information is no longer stored in marcxml field)
1192 my ($biblionumber) = @_;
1193 my $dbh = C4
::Context
->dbh;
1194 return unless $biblionumber;
1195 my ($marcxml) = $dbh->selectrow_array(
1198 FROM biblio_metadata
1199 WHERE biblionumber
=?
1200 AND format
='marcxml'
1202 |, undef, $biblionumber, C4
::Context
->preference('marcflavour')
1209 return the prices in accordance with the Marc format.
1211 returns 0 if no price found
1212 returns undef if called without a marc record or with
1213 an unrecognized marc format
1218 my ( $record, $marcflavour ) = @_;
1220 carp
'GetMarcPrice called on undefined record';
1227 if ( $marcflavour eq "MARC21" || $marcflavour eq "NORMARC" ) {
1228 @listtags = ('345', '020');
1230 } elsif ( $marcflavour eq "UNIMARC" ) {
1231 @listtags = ('345', '010');
1237 for my $field ( $record->field(@listtags) ) {
1238 for my $subfield_value ($field->subfield($subfield)){
1240 $subfield_value = MungeMarcPrice
( $subfield_value );
1241 return $subfield_value if ($subfield_value);
1244 return 0; # no price found
1247 =head2 MungeMarcPrice
1249 Return the best guess at what the actual price is from a price field.
1253 sub MungeMarcPrice
{
1255 return unless ( $price =~ m/\d/ ); ## No digits means no price.
1256 # Look for the currency symbol and the normalized code of the active currency, if it's there,
1257 my $active_currency = Koha
::Acquisition
::Currencies
->get_active;
1258 my $symbol = $active_currency->symbol;
1259 my $isocode = $active_currency->isocode;
1260 $isocode = $active_currency->currency unless defined $isocode;
1263 my @matches =($price=~ /
1265 ( # start of capturing parenthesis
1267 (?
:[\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'
1268 |(?
:\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'
1270 \s?\p
{Sc
}?\s?
# followed or not by a whitespace. \p{Sc}?\s? are for cases like '25$ USD'
1272 (?
:[\p
{Sc
}\p
{L
}\
/.]){1,4} # followed by same block as symbol block
1273 |(?
:\d
+[\p
{P
}\s
]?
){1,4} # or by same block as digits block
1275 \s?\p
{L
}{0,4}\s?
# followed or not by a whitespace. \p{L}{0,4}\s? are for cases like '$9.50 USD'
1276 ) # end of capturing parenthesis
1277 (?
:\p
{P
}|\z
) # followed by a punctuation sign or by the end of the string
1281 foreach ( @matches ) {
1282 $localprice = $_ and last if index($_, $isocode)>=0;
1284 if ( !$localprice ) {
1285 foreach ( @matches ) {
1286 $localprice = $_ and last if $_=~ /(^|[^\p{Sc}\p{L}\/])\Q
$symbol\E
([^\p
{Sc
}\p
{L
}\
/]+\z|\z)/;
1291 if ( $localprice ) {
1292 $price = $localprice;
1294 ## Grab the first number in the string ( can use commas or periods for thousands separator and/or decimal separator )
1295 ( $price ) = $price =~ m/([\d\,\.]+[[\,\.]\d\d]?)/;
1297 # eliminate symbol/isocode, space and any final dot from the string
1298 $price =~ s/[\p{Sc}\p{L}\/ ]|\.$//g
;
1299 # remove comma,dot when used as separators from hundreds
1300 $price =~s/[\,\.](\d{3})/$1/g;
1301 # convert comma to dot to ensure correct display of decimals if existing
1307 =head2 GetMarcQuantity
1309 return the quantity of a book. Used in acquisition only, when importing a file an iso2709 from a bookseller
1310 Warning : this is not really in the marc standard. In Unimarc, Electre (the most widely used bookseller) use the 969$a
1312 returns 0 if no quantity found
1313 returns undef if called without a marc record or with
1314 an unrecognized marc format
1318 sub GetMarcQuantity
{
1319 my ( $record, $marcflavour ) = @_;
1321 carp
'GetMarcQuantity called on undefined record';
1328 if ( $marcflavour eq "MARC21" ) {
1330 } elsif ( $marcflavour eq "UNIMARC" ) {
1331 @listtags = ('969');
1337 for my $field ( $record->field(@listtags) ) {
1338 for my $subfield_value ($field->subfield($subfield)){
1340 if ($subfield_value) {
1341 # in France, the cents separator is the , but sometimes, ppl use a .
1342 # in this case, the price will be x100 when unformatted ! Replace the . by a , to get a proper price calculation
1343 $subfield_value =~ s/\./,/ if C4
::Context
->preference("CurrencyFormat") eq "FR";
1344 return $subfield_value;
1348 return 0; # no price found
1352 =head2 GetAuthorisedValueDesc
1354 my $subfieldvalue =get_authorised_value_desc(
1355 $tag, $subf[$i][0],$subf[$i][1], '', $taglib, $category, $opac);
1357 Retrieve the complete description for a given authorised value.
1359 Now takes $category and $value pair too.
1361 my $auth_value_desc =GetAuthorisedValueDesc(
1362 '','', 'DVD' ,'','','CCODE');
1364 If the optional $opac parameter is set to a true value, displays OPAC
1365 descriptions rather than normal ones when they exist.
1369 sub GetAuthorisedValueDesc
{
1370 my ( $tag, $subfield, $value, $framework, $tagslib, $category, $opac ) = @_;
1374 return $value unless defined $tagslib->{$tag}->{$subfield}->{'authorised_value'};
1377 if ( $tagslib->{$tag}->{$subfield}->{'authorised_value'} eq "branches" ) {
1378 my $branch = Koha
::Libraries
->find($value);
1379 return $branch?
$branch->branchname: q{};
1383 if ( $tagslib->{$tag}->{$subfield}->{'authorised_value'} eq "itemtypes" ) {
1384 my $itemtype = Koha
::ItemTypes
->find( $value );
1385 return $itemtype ?
$itemtype->translated_description : q
||;
1388 #---- "true" authorized value
1389 $category = $tagslib->{$tag}->{$subfield}->{'authorised_value'};
1392 my $dbh = C4
::Context
->dbh;
1393 if ( $category ne "" ) {
1394 my $sth = $dbh->prepare( "SELECT lib, lib_opac FROM authorised_values WHERE category = ? AND authorised_value = ?" );
1395 $sth->execute( $category, $value );
1396 my $data = $sth->fetchrow_hashref;
1397 return ( $opac && $data->{'lib_opac'} ) ?
$data->{'lib_opac'} : $data->{'lib'};
1399 return $value; # if nothing is found return the original value
1403 =head2 GetMarcControlnumber
1405 $marccontrolnumber = GetMarcControlnumber($record,$marcflavour);
1407 Get the control number / record Identifier from the MARC record and return it.
1411 sub GetMarcControlnumber
{
1412 my ( $record, $marcflavour ) = @_;
1414 carp
'GetMarcControlnumber called on undefined record';
1417 my $controlnumber = "";
1418 # Control number or Record identifier are the same field in MARC21, UNIMARC and NORMARC
1419 # Keep $marcflavour for possible later use
1420 if ($marcflavour eq "MARC21" || $marcflavour eq "UNIMARC" || $marcflavour eq "NORMARC") {
1421 my $controlnumberField = $record->field('001');
1422 if ($controlnumberField) {
1423 $controlnumber = $controlnumberField->data();
1426 return $controlnumber;
1431 $marcisbnsarray = GetMarcISBN( $record, $marcflavour );
1433 Get all ISBNs from the MARC record and returns them in an array.
1434 ISBNs stored in different fields depending on MARC flavour
1439 my ( $record, $marcflavour ) = @_;
1441 carp
'GetMarcISBN called on undefined record';
1445 if ( $marcflavour eq "UNIMARC" ) {
1447 } else { # assume marc21 if not unimarc
1452 foreach my $field ( $record->field($scope) ) {
1453 my $isbn = $field->subfield( 'a' );
1454 if ( $isbn && $isbn ne "" ) {
1455 push @marcisbns, $isbn;
1465 $marcissnsarray = GetMarcISSN( $record, $marcflavour );
1467 Get all valid ISSNs from the MARC record and returns them in an array.
1468 ISSNs are stored in different fields depending on MARC flavour
1473 my ( $record, $marcflavour ) = @_;
1475 carp
'GetMarcISSN called on undefined record';
1479 if ( $marcflavour eq "UNIMARC" ) {
1482 else { # assume MARC21 or NORMARC
1486 foreach my $field ( $record->field($scope) ) {
1487 push @marcissns, $field->subfield( 'a' )
1488 if ( $field->subfield( 'a' ) ne "" );
1495 $marcnotesarray = GetMarcNotes( $record, $marcflavour );
1497 Get all notes from the MARC record and returns them in an array.
1498 The notes are stored in different fields depending on MARC flavour.
1499 MARC21 5XX $u subfields receive special attention as they are URIs.
1504 my ( $record, $marcflavour, $opac ) = @_;
1506 carp
'GetMarcNotes called on undefined record';
1510 my $scope = $marcflavour eq "UNIMARC"?
'3..': '5..';
1513 #MARC21 specs indicate some notes should be private if first indicator 0
1514 my %maybe_private = (
1522 my %blacklist = map { $_ => 1 }
1523 split( /,/, C4
::Context
->preference('NotesBlacklist'));
1524 foreach my $field ( $record->field($scope) ) {
1525 my $tag = $field->tag();
1526 next if $blacklist{ $tag };
1527 next if $opac && $maybe_private{$tag} && !$field->indicator(1);
1528 if( $marcflavour ne 'UNIMARC' && $field->subfield('u') ) {
1529 # Field 5XX$u always contains URI
1530 # Examples: 505u, 506u, 510u, 514u, 520u, 530u, 538u, 540u, 542u, 552u, 555u, 561u, 563u, 583u
1531 # We first push the other subfields, then all $u's separately
1532 # Leave further actions to the template (see e.g. opac-detail)
1534 join '', ( 'a' .. 't', 'v' .. 'z', '0' .. '9' ); # excl 'u'
1535 push @marcnotes, { marcnote
=> $field->as_string($othersub) };
1536 foreach my $sub ( $field->subfield('u') ) {
1537 $sub =~ s/^\s+|\s+$//g; # trim
1538 push @marcnotes, { marcnote
=> $sub };
1541 push @marcnotes, { marcnote
=> $field->as_string() };
1547 =head2 GetMarcSubjects
1549 $marcsubjcts = GetMarcSubjects($record,$marcflavour);
1551 Get all subjects from the MARC record and returns them in an array.
1552 The subjects are stored in different fields depending on MARC flavour
1556 sub GetMarcSubjects
{
1557 my ( $record, $marcflavour ) = @_;
1559 carp
'GetMarcSubjects called on undefined record';
1562 my ( $mintag, $maxtag, $fields_filter );
1563 if ( $marcflavour eq "UNIMARC" ) {
1566 $fields_filter = '6..';
1567 } else { # marc21/normarc
1570 $fields_filter = '6..';
1575 my $subject_limit = C4
::Context
->preference("TraceCompleteSubfields") ?
'su,complete-subfield' : 'su';
1576 my $AuthoritySeparator = C4
::Context
->preference('AuthoritySeparator');
1578 foreach my $field ( $record->field($fields_filter) ) {
1579 next unless ($field->tag() >= $mintag && $field->tag() <= $maxtag);
1581 my @subfields = $field->subfields();
1584 # if there is an authority link, build the links with an= subfield9
1585 my $subfield9 = $field->subfield('9');
1588 my $linkvalue = $subfield9;
1589 $linkvalue =~ s/(\(|\))//g;
1590 @link_loop = ( { limit
=> 'an', 'link' => $linkvalue } );
1591 $authoritylink = $linkvalue
1595 for my $subject_subfield (@subfields) {
1596 next if ( $subject_subfield->[0] eq '9' );
1598 # don't load unimarc subfields 3,4,5
1599 next if ( ( $marcflavour eq "UNIMARC" ) and ( $subject_subfield->[0] =~ /2|3|4|5/ ) );
1600 # don't load MARC21 subfields 2 (FIXME: any more subfields??)
1601 next if ( ( $marcflavour eq "MARC21" ) and ( $subject_subfield->[0] =~ /2/ ) );
1603 my $code = $subject_subfield->[0];
1604 my $value = $subject_subfield->[1];
1605 my $linkvalue = $value;
1606 $linkvalue =~ s/(\(|\))//g;
1607 # if no authority link, build a search query
1608 unless ($subfield9) {
1610 limit
=> $subject_limit,
1611 'link' => $linkvalue,
1612 operator
=> (scalar @link_loop) ?
' and ' : undef
1615 my @this_link_loop = @link_loop;
1617 unless ( $code eq '0' ) {
1618 push @subfields_loop, {
1621 link_loop
=> \
@this_link_loop,
1622 separator
=> (scalar @subfields_loop) ?
$AuthoritySeparator : ''
1627 push @marcsubjects, {
1628 MARCSUBJECT_SUBFIELDS_LOOP
=> \
@subfields_loop,
1629 authoritylink
=> $authoritylink,
1630 } if $authoritylink || @subfields_loop;
1633 return \
@marcsubjects;
1634 } #end getMARCsubjects
1636 =head2 GetMarcAuthors
1638 authors = GetMarcAuthors($record,$marcflavour);
1640 Get all authors from the MARC record and returns them in an array.
1641 The authors are stored in different fields depending on MARC flavour
1645 sub GetMarcAuthors
{
1646 my ( $record, $marcflavour ) = @_;
1648 carp
'GetMarcAuthors called on undefined record';
1651 my ( $mintag, $maxtag, $fields_filter );
1653 # tagslib useful only for UNIMARC author responsibilities
1655 if ( $marcflavour eq "UNIMARC" ) {
1656 # FIXME : we don't have the framework available, we take the default framework. May be buggy on some setups, will be usually correct.
1657 $tagslib = GetMarcStructure
( 1, '', { unsafe
=> 1 });
1660 $fields_filter = '7..';
1661 } else { # marc21/normarc
1664 $fields_filter = '7..';
1668 my $AuthoritySeparator = C4
::Context
->preference('AuthoritySeparator');
1670 foreach my $field ( $record->field($fields_filter) ) {
1671 next unless $field->tag() >= $mintag && $field->tag() <= $maxtag;
1674 my @subfields = $field->subfields();
1677 # if there is an authority link, build the link with Koha-Auth-Number: subfield9
1678 my $subfield9 = $field->subfield('9');
1680 my $linkvalue = $subfield9;
1681 $linkvalue =~ s/(\(|\))//g;
1682 @link_loop = ( { 'limit' => 'an', 'link' => $linkvalue } );
1687 for my $authors_subfield (@subfields) {
1688 next if ( $authors_subfield->[0] eq '9' );
1690 # unimarc3 contains the $3 of the author for UNIMARC.
1691 # For french academic libraries, it's the "ppn", and it's required for idref webservice
1692 $unimarc3 = $authors_subfield->[1] if $marcflavour eq 'UNIMARC' and $authors_subfield->[0] =~ /3/;
1694 # don't load unimarc subfields 3, 5
1695 next if ( $marcflavour eq 'UNIMARC' and ( $authors_subfield->[0] =~ /3|5/ ) );
1697 my $code = $authors_subfield->[0];
1698 my $value = $authors_subfield->[1];
1699 my $linkvalue = $value;
1700 $linkvalue =~ s/(\(|\))//g;
1701 # UNIMARC author responsibility
1702 if ( $marcflavour eq 'UNIMARC' and $code eq '4' ) {
1703 $value = GetAuthorisedValueDesc
( $field->tag(), $code, $value, '', $tagslib );
1704 $linkvalue = "($value)";
1706 # if no authority link, build a search query
1707 unless ($subfield9) {
1710 'link' => $linkvalue,
1711 operator
=> (scalar @link_loop) ?
' and ' : undef
1714 my @this_link_loop = @link_loop;
1716 unless ( $code eq '0') {
1717 push @subfields_loop, {
1718 tag
=> $field->tag(),
1721 link_loop
=> \
@this_link_loop,
1722 separator
=> (scalar @subfields_loop) ?
$AuthoritySeparator : ''
1726 push @marcauthors, {
1727 MARCAUTHOR_SUBFIELDS_LOOP
=> \
@subfields_loop,
1728 authoritylink
=> $subfield9,
1729 unimarc3
=> $unimarc3
1732 return \
@marcauthors;
1737 $marcurls = GetMarcUrls($record,$marcflavour);
1739 Returns arrayref of URLs from MARC data, suitable to pass to tmpl loop.
1740 Assumes web resources (not uncommon in MARC21 to omit resource type ind)
1745 my ( $record, $marcflavour ) = @_;
1747 carp
'GetMarcUrls called on undefined record';
1752 for my $field ( $record->field('856') ) {
1754 for my $note ( $field->subfield('z') ) {
1755 push @notes, { note
=> $note };
1757 my @urls = $field->subfield('u');
1758 foreach my $url (@urls) {
1759 $url =~ s/^\s+|\s+$//g; # trim
1761 if ( $marcflavour eq 'MARC21' ) {
1762 my $s3 = $field->subfield('3');
1763 my $link = $field->subfield('y');
1764 unless ( $url =~ /^\w+:/ ) {
1765 if ( $field->indicator(1) eq '7' ) {
1766 $url = $field->subfield('2') . "://" . $url;
1767 } elsif ( $field->indicator(1) eq '1' ) {
1768 $url = 'ftp://' . $url;
1771 # properly, this should be if ind1=4,
1772 # however we will assume http protocol since we're building a link.
1773 $url = 'http://' . $url;
1777 # TODO handle ind 2 (relationship)
1782 $marcurl->{'linktext'} = $link || $s3 || C4
::Context
->preference('URLLinkText') || $url;
1783 $marcurl->{'part'} = $s3 if ($link);
1784 $marcurl->{'toc'} = 1 if ( defined($s3) && $s3 =~ /^[Tt]able/ );
1786 $marcurl->{'linktext'} = $field->subfield('2') || C4
::Context
->preference('URLLinkText') || $url;
1787 $marcurl->{'MARCURL'} = $url;
1789 push @marcurls, $marcurl;
1795 =head2 GetMarcSeries
1797 $marcseriesarray = GetMarcSeries($record,$marcflavour);
1799 Get all series from the MARC record and returns them in an array.
1800 The series are stored in different fields depending on MARC flavour
1805 my ( $record, $marcflavour ) = @_;
1807 carp
'GetMarcSeries called on undefined record';
1811 my ( $mintag, $maxtag, $fields_filter );
1812 if ( $marcflavour eq "UNIMARC" ) {
1815 $fields_filter = '2..';
1816 } else { # marc21/normarc
1819 $fields_filter = '4..';
1823 my $AuthoritySeparator = C4
::Context
->preference('AuthoritySeparator');
1825 foreach my $field ( $record->field($fields_filter) ) {
1826 next unless $field->tag() >= $mintag && $field->tag() <= $maxtag;
1828 my @subfields = $field->subfields();
1831 for my $series_subfield (@subfields) {
1833 # ignore $9, used for authority link
1834 next if ( $series_subfield->[0] eq '9' );
1837 my $code = $series_subfield->[0];
1838 my $value = $series_subfield->[1];
1839 my $linkvalue = $value;
1840 $linkvalue =~ s/(\(|\))//g;
1842 # see if this is an instance of a volume
1843 if ( $code eq 'v' ) {
1848 'link' => $linkvalue,
1849 operator
=> (scalar @link_loop) ?
' and ' : undef
1852 if ($volume_number) {
1853 push @subfields_loop, { volumenum
=> $value };
1855 push @subfields_loop, {
1858 link_loop
=> \
@link_loop,
1859 separator
=> (scalar @subfields_loop) ?
$AuthoritySeparator : '',
1860 volumenum
=> $volume_number,
1864 push @marcseries, { MARCSERIES_SUBFIELDS_LOOP
=> \
@subfields_loop };
1867 return \
@marcseries;
1868 } #end getMARCseriess
1872 $marchostsarray = GetMarcHosts($record,$marcflavour);
1874 Get all host records (773s MARC21, 461 UNIMARC) from the MARC record and returns them in an array.
1879 my ( $record, $marcflavour ) = @_;
1881 carp
'GetMarcHosts called on undefined record';
1885 my ( $tag,$title_subf,$bibnumber_subf,$itemnumber_subf);
1886 $marcflavour ||="MARC21";
1887 if ( $marcflavour eq "MARC21" || $marcflavour eq "NORMARC" ) {
1890 $bibnumber_subf ="0";
1891 $itemnumber_subf='9';
1893 elsif ($marcflavour eq "UNIMARC") {
1896 $bibnumber_subf ="0";
1897 $itemnumber_subf='9';
1902 foreach my $field ( $record->field($tag)) {
1906 my $hostbiblionumber = $field->subfield("$bibnumber_subf");
1907 my $hosttitle = $field->subfield($title_subf);
1908 my $hostitemnumber=$field->subfield($itemnumber_subf);
1909 push @fields_loop, { hostbiblionumber
=> $hostbiblionumber, hosttitle
=> $hosttitle, hostitemnumber
=> $hostitemnumber};
1910 push @marchosts, { MARCHOSTS_FIELDS_LOOP
=> \
@fields_loop };
1913 my $marchostsarray = \
@marchosts;
1914 return $marchostsarray;
1917 =head2 UpsertMarcSubfield
1919 my $record = C4::Biblio::UpsertMarcSubfield($MARC::Record, $fieldTag, $subfieldCode, $subfieldContent);
1923 sub UpsertMarcSubfield
{
1924 my ($record, $tag, $code, $content) = @_;
1925 my $f = $record->field($tag);
1928 $f->update( $code => $content );
1931 my $f = MARC
::Field
->new( $tag, '', '', $code => $content);
1932 $record->insert_fields_ordered( $f );
1936 =head2 UpsertMarcControlField
1938 my $record = C4::Biblio::UpsertMarcControlField($MARC::Record, $fieldTag, $content);
1942 sub UpsertMarcControlField
{
1943 my ($record, $tag, $content) = @_;
1944 die "UpsertMarcControlField() \$tag '$tag' is not a control field\n" unless 0+$tag < 10;
1945 my $f = $record->field($tag);
1948 $f->update( $content );
1951 my $f = MARC
::Field
->new($tag, $content);
1952 $record->insert_fields_ordered( $f );
1956 =head2 GetFrameworkCode
1958 $frameworkcode = GetFrameworkCode( $biblionumber )
1962 sub GetFrameworkCode
{
1963 my ($biblionumber) = @_;
1964 my $dbh = C4
::Context
->dbh;
1965 my $sth = $dbh->prepare("SELECT frameworkcode FROM biblio WHERE biblionumber=?");
1966 $sth->execute($biblionumber);
1967 my ($frameworkcode) = $sth->fetchrow;
1968 return $frameworkcode;
1971 =head2 TransformKohaToMarc
1973 $record = TransformKohaToMarc( $hash [, $params ] )
1975 This function builds a (partial) MARC::Record from a hash.
1976 Hash entries can be from biblio, biblioitems or items.
1977 The params hash includes the parameter no_split used in C4::Items.
1979 This function is called in acquisition module, to create a basic catalogue
1980 entry from user entry.
1985 sub TransformKohaToMarc
{
1986 my ( $hash, $params ) = @_;
1987 my $record = MARC
::Record
->new();
1988 SetMarcUnicodeFlag
( $record, C4
::Context
->preference("marcflavour") );
1990 # In the next call we use the Default framework, since it is considered
1991 # authoritative for Koha to Marc mappings.
1992 my $mss = GetMarcSubfieldStructure
( '', { unsafe
=> 1 } ); # do not change framewok
1994 while ( my ($kohafield, $value) = each %$hash ) {
1995 foreach my $fld ( @
{ $mss->{$kohafield} } ) {
1996 my $tagfield = $fld->{tagfield
};
1997 my $tagsubfield = $fld->{tagsubfield
};
1999 my @values = $params->{no_split
}
2001 : split(/\s?\|\s?/, $value, -1);
2002 foreach my $value ( @values ) {
2003 next if $value eq '';
2004 $tag_hr->{$tagfield} //= [];
2005 push @
{$tag_hr->{$tagfield}}, [($tagsubfield, $value)];
2009 foreach my $tag (sort keys %$tag_hr) {
2010 my @sfl = @
{$tag_hr->{$tag}};
2011 @sfl = sort { $a->[0] cmp $b->[0]; } @sfl;
2012 @sfl = map { @
{$_}; } @sfl;
2013 # Special care for control fields: remove the subfield indication @
2014 # and do not insert indicators.
2015 my @ind = $tag < 10 ?
() : ( " ", " " );
2016 @sfl = grep { $_ ne '@' } @sfl if $tag < 10;
2017 $record->insert_fields_ordered( MARC
::Field
->new($tag, @ind, @sfl) );
2022 =head2 PrepHostMarcField
2024 $hostfield = PrepHostMarcField ( $hostbiblionumber,$hostitemnumber,$marcflavour )
2026 This function returns a host field populated with data from the host record, the field can then be added to an analytical record
2030 sub PrepHostMarcField
{
2031 my ($hostbiblionumber,$hostitemnumber, $marcflavour) = @_;
2032 $marcflavour ||="MARC21";
2034 my $hostrecord = GetMarcBiblio
({ biblionumber
=> $hostbiblionumber });
2035 my $item = Koha
::Items
->find($hostitemnumber);
2038 if ( $marcflavour eq "MARC21" || $marcflavour eq "NORMARC" ) {
2042 if ($hostrecord->subfield('100','a')){
2043 $mainentry = $hostrecord->subfield('100','a');
2044 } elsif ($hostrecord->subfield('110','a')){
2045 $mainentry = $hostrecord->subfield('110','a');
2047 $mainentry = $hostrecord->subfield('111','a');
2050 # qualification info
2052 if (my $field260 = $hostrecord->field('260')){
2053 $qualinfo = $field260->as_string( 'abc' );
2058 my $ed = $hostrecord->subfield('250','a');
2059 my $barcode = $item->barcode;
2060 my $title = $hostrecord->subfield('245','a');
2062 # record control number, 001 with 003 and prefix
2064 if ($hostrecord->field('001')){
2065 $recctrlno = $hostrecord->field('001')->data();
2066 if ($hostrecord->field('003')){
2067 $recctrlno = '('.$hostrecord->field('003')->data().')'.$recctrlno;
2072 my $issn = $hostrecord->subfield('022','a');
2073 my $isbn = $hostrecord->subfield('020','a');
2076 $hostmarcfield = MARC
::Field
->new(
2078 '0' => $hostbiblionumber,
2079 '9' => $hostitemnumber,
2089 } elsif ($marcflavour eq "UNIMARC") {
2090 $hostmarcfield = MARC
::Field
->new(
2092 '0' => $hostbiblionumber,
2093 't' => $hostrecord->subfield('200','a'),
2094 '9' => $hostitemnumber
2098 return $hostmarcfield;
2101 =head2 TransformHtmlToXml
2103 $xml = TransformHtmlToXml( $tags, $subfields, $values, $indicator,
2104 $ind_tag, $auth_type )
2106 $auth_type contains :
2110 =item - nothing : rebuild a biblio. In UNIMARC the encoding is in 100$a pos 26/27
2112 =item - UNIMARCAUTH : rebuild an authority. In UNIMARC, the encoding is in 100$a pos 13/14
2114 =item - ITEM : rebuild an item : in UNIMARC, 100$a, it's in the biblio ! (otherwise, we would get 2 100 fields !)
2120 sub TransformHtmlToXml
{
2121 my ( $tags, $subfields, $values, $indicator, $ind_tag, $auth_type ) = @_;
2122 # NOTE: The parameter $ind_tag is NOT USED -- BZ 11247
2124 my $xml = MARC
::File
::XML
::header
('UTF-8');
2125 $xml .= "<record>\n";
2126 $auth_type = C4
::Context
->preference('marcflavour') unless $auth_type;
2127 MARC
::File
::XML
->default_record_format($auth_type);
2129 # in UNIMARC, field 100 contains the encoding
2130 # check that there is one, otherwise the
2131 # MARC::Record->new_from_xml will fail (and Koha will die)
2132 my $unimarc_and_100_exist = 0;
2133 $unimarc_and_100_exist = 1 if $auth_type eq 'ITEM'; # if we rebuild an item, no need of a 100 field
2139 for ( my $i = 0 ; $i < @
$tags ; $i++ ) {
2141 if ( C4
::Context
->preference('marcflavour') eq 'UNIMARC' and @
$tags[$i] eq "100" and @
$subfields[$i] eq "a" ) {
2143 # if we have a 100 field and it's values are not correct, skip them.
2144 # if we don't have any valid 100 field, we will create a default one at the end
2145 my $enc = substr( @
$values[$i], 26, 2 );
2146 if ( $enc eq '01' or $enc eq '50' or $enc eq '03' ) {
2147 $unimarc_and_100_exist = 1;
2152 @
$values[$i] =~ s/&/&/g;
2153 @
$values[$i] =~ s/</</g;
2154 @
$values[$i] =~ s/>/>/g;
2155 @
$values[$i] =~ s/"/"/g;
2156 @
$values[$i] =~ s/'/'/g;
2158 if ( ( @
$tags[$i] ne $prevtag ) ) {
2159 $close_last_tag = 0;
2160 $j++ unless ( @
$tags[$i] eq "" );
2161 my $str = ( $indicator->[$j] // q{} ) . ' '; # extra space prevents substr outside of string warn
2162 my $ind1 = _default_ind_to_space
( substr( $str, 0, 1 ) );
2163 my $ind2 = _default_ind_to_space
( substr( $str, 1, 1 ) );
2165 $xml .= "</datafield>\n";
2166 if ( ( @
$tags[$i] && @
$tags[$i] > 10 )
2167 && ( @
$values[$i] ne "" ) ) {
2168 $xml .= "<datafield tag=\"@$tags[$i]\" ind1=\"$ind1\" ind2=\"$ind2\">\n";
2169 $xml .= "<subfield code=\"@$subfields[$i]\">@$values[$i]</subfield>\n";
2171 $close_last_tag = 1;
2176 if ( @
$values[$i] ne "" ) {
2179 if ( @
$tags[$i] eq "000" ) {
2180 $xml .= "<leader>@$values[$i]</leader>\n";
2183 # rest of the fixed fields
2184 } elsif ( @
$tags[$i] < 10 ) {
2185 $xml .= "<controlfield tag=\"@$tags[$i]\">@$values[$i]</controlfield>\n";
2188 $xml .= "<datafield tag=\"@$tags[$i]\" ind1=\"$ind1\" ind2=\"$ind2\">\n";
2189 $xml .= "<subfield code=\"@$subfields[$i]\">@$values[$i]</subfield>\n";
2191 $close_last_tag = 1;
2195 } else { # @$tags[$i] eq $prevtag
2196 if ( @
$values[$i] eq "" ) {
2199 my $str = ( $indicator->[$j] // q{} ) . ' '; # extra space prevents substr outside of string warn
2200 my $ind1 = _default_ind_to_space
( substr( $str, 0, 1 ) );
2201 my $ind2 = _default_ind_to_space
( substr( $str, 1, 1 ) );
2202 $xml .= "<datafield tag=\"@$tags[$i]\" ind1=\"$ind1\" ind2=\"$ind2\">\n";
2204 $close_last_tag = 1;
2206 $xml .= "<subfield code=\"@$subfields[$i]\">@$values[$i]</subfield>\n";
2209 $prevtag = @
$tags[$i];
2211 $xml .= "</datafield>\n" if $close_last_tag;
2212 if ( C4
::Context
->preference('marcflavour') eq 'UNIMARC' and !$unimarc_and_100_exist ) {
2214 # warn "SETTING 100 for $auth_type";
2215 my $string = strftime
( "%Y%m%d", localtime(time) );
2217 # set 50 to position 26 is biblios, 13 if authorities
2219 $pos = 13 if $auth_type eq 'UNIMARCAUTH';
2220 $string = sprintf( "%-*s", 35, $string );
2221 substr( $string, $pos, 6, "50" );
2222 $xml .= "<datafield tag=\"100\" ind1=\"\" ind2=\"\">\n";
2223 $xml .= "<subfield code=\"a\">$string</subfield>\n";
2224 $xml .= "</datafield>\n";
2226 $xml .= "</record>\n";
2227 $xml .= MARC
::File
::XML
::footer
();
2231 =head2 _default_ind_to_space
2233 Passed what should be an indicator returns a space
2234 if its undefined or zero length
2238 sub _default_ind_to_space
{
2240 if ( !defined $s || $s eq q{} ) {
2246 =head2 TransformHtmlToMarc
2248 L<$record> = TransformHtmlToMarc(L<$cgi>)
2249 L<$cgi> is the CGI object which contains the values for subfields
2251 'tag_010_indicator1_531951' ,
2252 'tag_010_indicator2_531951' ,
2253 'tag_010_code_a_531951_145735' ,
2254 'tag_010_subfield_a_531951_145735' ,
2255 'tag_200_indicator1_873510' ,
2256 'tag_200_indicator2_873510' ,
2257 'tag_200_code_a_873510_673465' ,
2258 'tag_200_subfield_a_873510_673465' ,
2259 'tag_200_code_b_873510_704318' ,
2260 'tag_200_subfield_b_873510_704318' ,
2261 'tag_200_code_e_873510_280822' ,
2262 'tag_200_subfield_e_873510_280822' ,
2263 'tag_200_code_f_873510_110730' ,
2264 'tag_200_subfield_f_873510_110730' ,
2266 L<$record> is the MARC::Record object.
2270 sub TransformHtmlToMarc
{
2271 my ($cgi, $isbiblio) = @_;
2273 my @params = $cgi->multi_param();
2275 # explicitly turn on the UTF-8 flag for all
2276 # 'tag_' parameters to avoid incorrect character
2277 # conversion later on
2278 my $cgi_params = $cgi->Vars;
2279 foreach my $param_name ( keys %$cgi_params ) {
2280 if ( $param_name =~ /^tag_/ ) {
2281 my $param_value = $cgi_params->{$param_name};
2282 unless ( Encode
::is_utf8
( $param_value ) ) {
2283 $cgi_params->{$param_name} = Encode
::decode
('UTF-8', $param_value );
2288 # creating a new record
2289 my $record = MARC
::Record
->new();
2291 my ($biblionumbertagfield, $biblionumbertagsubfield) = (-1, -1);
2292 ($biblionumbertagfield, $biblionumbertagsubfield) =
2293 &GetMarcFromKohaField
( "biblio.biblionumber", '' ) if $isbiblio;
2294 #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!
2295 for (my $i = 0; $params[$i]; $i++ ) { # browse all CGI params
2296 my $param = $params[$i];
2299 # if we are on biblionumber, store it in the MARC::Record (it may not be in the edited fields)
2300 if ( $param eq 'biblionumber' ) {
2301 if ( $biblionumbertagfield < 10 ) {
2302 $newfield = MARC
::Field
->new( $biblionumbertagfield, scalar $cgi->param($param), );
2304 $newfield = MARC
::Field
->new( $biblionumbertagfield, '', '', "$biblionumbertagsubfield" => scalar $cgi->param($param), );
2306 push @fields, $newfield if ($newfield);
2307 } elsif ( $param =~ /^tag_(\d*)_indicator1_/ ) { # new field start when having 'input name="..._indicator1_..."
2310 my $ind1 = _default_ind_to_space
( substr( $cgi->param($param), 0, 1 ) );
2311 my $ind2 = _default_ind_to_space
( substr( $cgi->param( $params[ $i + 1 ] ), 0, 1 ) );
2315 if ( $tag < 10 ) { # no code for theses fields
2316 # in MARC editor, 000 contains the leader.
2317 next if $tag == $biblionumbertagfield;
2318 my $fval= $cgi->param($params[$j+1]);
2319 if ( $tag eq '000' ) {
2320 # Force a fake leader even if not provided to avoid crashing
2321 # during decoding MARC record containing UTF-8 characters
2323 length( $fval ) == 24
2328 # between 001 and 009 (included)
2329 } elsif ( $fval ne '' ) {
2330 $newfield = MARC
::Field
->new( $tag, $fval, );
2333 # > 009, deal with subfields
2335 # browse subfields for this tag (reason for _code_ match)
2336 while(defined $params[$j] && $params[$j] =~ /_code_/) {
2337 last unless defined $params[$j+1];
2339 if $tag == $biblionumbertagfield and
2340 $cgi->param($params[$j]) eq $biblionumbertagsubfield;
2341 #if next param ne subfield, then it was probably empty
2342 #try next param by incrementing j
2343 if($params[$j+1]!~/_subfield_/) {$j++; next; }
2344 my $fkey= $cgi->param($params[$j]);
2345 my $fval= $cgi->param($params[$j+1]);
2346 #check if subfield value not empty and field exists
2347 if($fval ne '' && $newfield) {
2348 $newfield->add_subfields( $fkey => $fval);
2350 elsif($fval ne '') {
2351 $newfield = MARC
::Field
->new( $tag, $ind1, $ind2, $fkey => $fval );
2355 $i= $j-1; #update i for outer loop accordingly
2357 push @fields, $newfield if ($newfield);
2361 @fields = sort { $a->tag() cmp $b->tag() } @fields;
2362 $record->append_fields(@fields);
2366 =head2 TransformMarcToKoha
2368 $result = TransformMarcToKoha( $record, undef, $limit )
2370 Extract data from a MARC bib record into a hashref representing
2371 Koha biblio, biblioitems, and items fields.
2373 If passed an undefined record will log the error and return an empty
2378 sub TransformMarcToKoha
{
2379 my ( $record, $frameworkcode, $limit_table ) = @_;
2380 # FIXME Parameter $frameworkcode is obsolete and will be removed
2381 $limit_table //= q{};
2384 if (!defined $record) {
2385 carp
('TransformMarcToKoha called with undefined record');
2389 my %tables = ( biblio
=> 1, biblioitems
=> 1, items
=> 1 );
2390 if( $limit_table eq 'items' ) {
2391 %tables = ( items
=> 1 );
2394 # The next call acknowledges Default as the authoritative framework
2395 # for Koha to MARC mappings.
2396 my $mss = GetMarcSubfieldStructure
( '', { unsafe
=> 1 } ); # Do not change framework
2397 foreach my $kohafield ( keys %{ $mss } ) {
2398 my ( $table, $column ) = split /[.]/, $kohafield, 2;
2399 next unless $tables{$table};
2400 my $val = TransformMarcToKohaOneField
( $kohafield, $record );
2401 next if !defined $val;
2402 my $key = _disambiguate
( $table, $column );
2403 $result->{$key} = $val;
2408 =head2 _disambiguate
2410 $newkey = _disambiguate($table, $field);
2412 This is a temporary hack to distinguish between the
2413 following sets of columns when using TransformMarcToKoha.
2415 items.cn_source & biblioitems.cn_source
2416 items.cn_sort & biblioitems.cn_sort
2418 Columns that are currently NOT distinguished (FIXME
2419 due to lack of time to fully test) are:
2421 biblio.notes and biblioitems.notes
2426 FIXME - this is necessary because prefixing each column
2427 name with the table name would require changing lots
2428 of code and templates, and exposing more of the DB
2429 structure than is good to the UI templates, particularly
2430 since biblio and bibloitems may well merge in a future
2431 version. In the future, it would also be good to
2432 separate DB access and UI presentation field names
2438 my ( $table, $column ) = @_;
2439 if ( $column eq "cn_sort" or $column eq "cn_source" ) {
2440 return $table . '.' . $column;
2447 =head2 TransformMarcToKohaOneField
2449 $val = TransformMarcToKohaOneField( 'biblio.title', $marc );
2451 Note: The authoritative Default framework is used implicitly.
2455 sub TransformMarcToKohaOneField
{
2456 my ( $kohafield, $marc ) = @_;
2458 my ( @rv, $retval );
2459 my @mss = GetMarcSubfieldStructureFromKohaField
($kohafield);
2460 foreach my $fldhash ( @mss ) {
2461 my $tag = $fldhash->{tagfield
};
2462 my $sub = $fldhash->{tagsubfield
};
2463 foreach my $fld ( $marc->field($tag) ) {
2464 if( $sub eq '@' || $fld->is_control_field ) {
2465 push @rv, $fld->data if $fld->data;
2467 push @rv, grep { $_ } $fld->subfield($sub);
2472 $retval = join ' | ', uniq
(@rv);
2474 # Additional polishing for individual kohafields
2475 if( $kohafield =~ /copyrightdate|publicationyear/ ) {
2476 $retval = _adjust_pubyear
( $retval );
2482 =head2 _adjust_pubyear
2484 Helper routine for TransformMarcToKohaOneField
2488 sub _adjust_pubyear
{
2490 # modify return value to keep only the 1st year found
2491 if( $retval =~ m/c(\d\d\d\d)/ and $1 > 0 ) { # search cYYYY first
2493 } elsif( $retval =~ m/(\d\d\d\d)/ && $1 > 0 ) {
2495 } elsif( $retval =~ m
/
2496 (?
<year
>\d
)[-]?
[.Xx?
]{3}
2497 |(?
<year
>\d
{2})[.Xx?
]{2}
2498 |(?
<year
>\d
{3})[.Xx?
]
2499 |(?
<year
>\d
)[-]{3}\?
2500 |(?
<year
>\d\d
)[-]{2}\?
2501 |(?
<year
>\d
{3})[-]\?
2502 /xms
) { # the form 198-? occurred in Dutch ISBD rules
2503 my $digits = $+{year
};
2504 $retval = $digits * ( 10 ** ( 4 - length($digits) ));
2509 =head2 CountItemsIssued
2511 my $count = CountItemsIssued( $biblionumber );
2515 sub CountItemsIssued
{
2516 my ($biblionumber) = @_;
2517 my $dbh = C4
::Context
->dbh;
2518 my $sth = $dbh->prepare('SELECT COUNT(*) as issuedCount FROM items, issues WHERE items.itemnumber = issues.itemnumber AND items.biblionumber = ?');
2519 $sth->execute($biblionumber);
2520 my $row = $sth->fetchrow_hashref();
2521 return $row->{'issuedCount'};
2526 ModZebra( $biblionumber, $op, $server, $record );
2528 $biblionumber is the biblionumber we want to index
2530 $op is specialUpdate or recordDelete, and is used to know what we want to do
2532 $server is the server that we want to update
2534 $record is the update MARC record if it's available. If it's not supplied
2535 and is needed, it'll be loaded from the database.
2540 ###Accepts a $server variable thus we can use it for biblios authorities or other zebra dbs
2541 my ( $biblionumber, $op, $server, $record ) = @_;
2542 $debug && warn "ModZebra: update requested for: $biblionumber $op $server\n";
2543 if ( C4
::Context
->preference('SearchEngine') eq 'Elasticsearch' ) {
2545 # TODO abstract to a standard API that'll work for whatever
2546 require Koha
::SearchEngine
::Elasticsearch
::Indexer
;
2547 my $indexer = Koha
::SearchEngine
::Elasticsearch
::Indexer
->new(
2549 index => $server eq 'biblioserver'
2550 ?
$Koha::SearchEngine
::BIBLIOS_INDEX
2551 : $Koha::SearchEngine
::AUTHORITIES_INDEX
2554 if ( $op eq 'specialUpdate' ) {
2556 $record = GetMarcBiblio
({
2557 biblionumber
=> $biblionumber,
2558 embed_items
=> 1 });
2560 my $records = [$record];
2561 $indexer->update_index_background( [$biblionumber], [$record] );
2563 elsif ( $op eq 'recordDelete' ) {
2564 $indexer->delete_index_background( [$biblionumber] );
2567 croak
"ModZebra called with unknown operation: $op";
2571 my $dbh = C4
::Context
->dbh;
2573 # true ModZebra commented until indexdata fixes zebraDB crashes (it seems they occur on multiple updates
2575 # replaced by a zebraqueue table, that is filled with ModZebra to run.
2576 # the table is emptied by rebuild_zebra.pl script (using the -z switch)
2577 my $check_sql = "SELECT COUNT(*) FROM zebraqueue
2579 AND biblio_auth_number = ?
2582 my $check_sth = $dbh->prepare_cached($check_sql);
2583 $check_sth->execute( $server, $biblionumber, $op );
2584 my ($count) = $check_sth->fetchrow_array;
2585 $check_sth->finish();
2586 if ( $count == 0 ) {
2587 my $sth = $dbh->prepare("INSERT INTO zebraqueue (biblio_auth_number,server,operation) VALUES(?,?,?)");
2588 $sth->execute( $biblionumber, $server, $op );
2594 =head2 EmbedItemsInMarcBiblio
2596 EmbedItemsInMarcBiblio({
2597 marc_record => $marc,
2598 biblionumber => $biblionumber,
2599 item_numbers => $itemnumbers,
2602 Given a MARC::Record object containing a bib record,
2603 modify it to include the items attached to it as 9XX
2604 per the bib's MARC framework.
2605 if $itemnumbers is defined, only specified itemnumbers are embedded.
2607 If $opac is true, then opac-relevant suppressions are included.
2609 If opac filtering will be done, borcat should be passed to properly
2610 override if necessary.
2614 sub EmbedItemsInMarcBiblio
{
2616 my ($marc, $biblionumber, $itemnumbers, $opac, $borcat);
2617 $marc = $params->{marc_record
};
2619 carp
'EmbedItemsInMarcBiblio: No MARC record passed';
2622 $biblionumber = $params->{biblionumber
};
2623 $itemnumbers = $params->{item_numbers
};
2624 $opac = $params->{opac
};
2625 $borcat = $params->{borcat
} // q{};
2627 $itemnumbers = [] unless defined $itemnumbers;
2629 my $frameworkcode = GetFrameworkCode
($biblionumber);
2630 _strip_item_fields
($marc, $frameworkcode);
2632 # ... and embed the current items
2633 my $dbh = C4
::Context
->dbh;
2634 my $sth = $dbh->prepare("SELECT itemnumber FROM items WHERE biblionumber = ?");
2635 $sth->execute($biblionumber);
2636 my ( $itemtag, $itemsubfield ) = GetMarcFromKohaField
( "items.itemnumber" );
2638 my @item_fields; # Array holding the actual MARC data for items to be included.
2639 my @items; # Array holding items which are both in the list (sitenumbers)
2640 # and on this biblionumber
2642 # Flag indicating if there is potential hiding.
2643 my $opachiddenitems = $opac
2644 && ( C4
::Context
->preference('OpacHiddenItems') !~ /^\s*$/ );
2647 while ( my ($itemnumber) = $sth->fetchrow_array ) {
2648 next if @
$itemnumbers and not grep { $_ == $itemnumber } @
$itemnumbers;
2650 if ( $opachiddenitems ) {
2651 $item = Koha
::Items
->find($itemnumber);
2652 $item = $item ?
$item->unblessed : undef;
2654 push @items, { itemnumber
=> $itemnumber, item
=> $item };
2656 my @items2pass = map { $_->{item
} } @items;
2659 ? C4
::Items
::GetHiddenItemnumbers
({
2660 items
=> \
@items2pass,
2661 borcat
=> $borcat })
2663 # Convert to a hash for quick searching
2664 my %hiddenitems = map { $_ => 1 } @hiddenitems;
2665 foreach my $itemnumber ( map { $_->{itemnumber
} } @items ) {
2666 next if $hiddenitems{$itemnumber};
2667 my $item_marc = C4
::Items
::GetMarcItem
( $biblionumber, $itemnumber );
2668 push @item_fields, $item_marc->field($itemtag);
2670 $marc->append_fields(@item_fields);
2673 =head1 INTERNAL FUNCTIONS
2675 =head2 _koha_marc_update_bib_ids
2678 _koha_marc_update_bib_ids($record, $frameworkcode, $biblionumber, $biblioitemnumber);
2680 Internal function to add or update biblionumber and biblioitemnumber to
2685 sub _koha_marc_update_bib_ids
{
2686 my ( $record, $frameworkcode, $biblionumber, $biblioitemnumber ) = @_;
2688 my ( $biblio_tag, $biblio_subfield ) = GetMarcFromKohaField
( "biblio.biblionumber" );
2689 die qq{No biblionumber tag
for framework
"$frameworkcode"} unless $biblio_tag;
2690 my ( $biblioitem_tag, $biblioitem_subfield ) = GetMarcFromKohaField
( "biblioitems.biblioitemnumber" );
2691 die qq{No biblioitemnumber tag
for framework
"$frameworkcode"} unless $biblioitem_tag;
2693 if ( $biblio_tag < 10 ) {
2694 C4
::Biblio
::UpsertMarcControlField
( $record, $biblio_tag, $biblionumber );
2696 C4
::Biblio
::UpsertMarcSubfield
($record, $biblio_tag, $biblio_subfield, $biblionumber);
2698 if ( $biblioitem_tag < 10 ) {
2699 C4
::Biblio
::UpsertMarcControlField
( $record, $biblioitem_tag, $biblioitemnumber );
2701 C4
::Biblio
::UpsertMarcSubfield
($record, $biblioitem_tag, $biblioitem_subfield, $biblioitemnumber);
2705 =head2 _koha_marc_update_biblioitem_cn_sort
2707 _koha_marc_update_biblioitem_cn_sort($marc, $biblioitem, $frameworkcode);
2709 Given a MARC bib record and the biblioitem hash, update the
2710 subfield that contains a copy of the value of biblioitems.cn_sort.
2714 sub _koha_marc_update_biblioitem_cn_sort
{
2716 my $biblioitem = shift;
2717 my $frameworkcode = shift;
2719 my ( $biblioitem_tag, $biblioitem_subfield ) = GetMarcFromKohaField
( "biblioitems.cn_sort" );
2720 return unless $biblioitem_tag;
2722 my ($cn_sort) = GetClassSort
( $biblioitem->{'biblioitems.cn_source'}, $biblioitem->{'cn_class'}, $biblioitem->{'cn_item'} );
2724 if ( my $field = $marc->field($biblioitem_tag) ) {
2725 $field->delete_subfield( code
=> $biblioitem_subfield );
2726 if ( $cn_sort ne '' ) {
2727 $field->add_subfields( $biblioitem_subfield => $cn_sort );
2731 # if we get here, no biblioitem tag is present in the MARC record, so
2732 # we'll create it if $cn_sort is not empty -- this would be
2733 # an odd combination of events, however
2735 $marc->insert_grouped_field( MARC
::Field
->new( $biblioitem_tag, ' ', ' ', $biblioitem_subfield => $cn_sort ) );
2740 =head2 _koha_add_biblio
2742 my ($biblionumber,$error) = _koha_add_biblio($dbh,$biblioitem);
2744 Internal function to add a biblio ($biblio is a hash with the values)
2748 sub _koha_add_biblio
{
2749 my ( $dbh, $biblio, $frameworkcode ) = @_;
2753 # set the series flag
2754 unless (defined $biblio->{'serial'}){
2755 $biblio->{'serial'} = 0;
2756 if ( $biblio->{'seriestitle'} ) { $biblio->{'serial'} = 1 }
2759 my $query = "INSERT INTO biblio
2760 SET frameworkcode = ?,
2775 my $sth = $dbh->prepare($query);
2777 $frameworkcode, $biblio->{'author'}, $biblio->{'title'}, $biblio->{'subtitle'},
2778 $biblio->{'medium'}, $biblio->{'part_number'}, $biblio->{'part_name'}, $biblio->{'unititle'},
2779 $biblio->{'notes'}, $biblio->{'serial'}, $biblio->{'seriestitle'}, $biblio->{'copyrightdate'},
2780 $biblio->{'abstract'}
2783 my $biblionumber = $dbh->{'mysql_insertid'};
2784 if ( $dbh->errstr ) {
2785 $error .= "ERROR in _koha_add_biblio $query" . $dbh->errstr;
2791 #warn "LEAVING _koha_add_biblio: ".$biblionumber."\n";
2792 return ( $biblionumber, $error );
2795 =head2 _koha_modify_biblio
2797 my ($biblionumber,$error) == _koha_modify_biblio($dbh,$biblio,$frameworkcode);
2799 Internal function for updating the biblio table
2803 sub _koha_modify_biblio
{
2804 my ( $dbh, $biblio, $frameworkcode ) = @_;
2809 SET frameworkcode = ?,
2822 WHERE biblionumber = ?
2825 my $sth = $dbh->prepare($query);
2828 $frameworkcode, $biblio->{'author'}, $biblio->{'title'}, $biblio->{'subtitle'},
2829 $biblio->{'medium'}, $biblio->{'part_number'}, $biblio->{'part_name'}, $biblio->{'unititle'},
2830 $biblio->{'notes'}, $biblio->{'serial'}, $biblio->{'seriestitle'}, $biblio->{'copyrightdate'} ?
int($biblio->{'copyrightdate'}) : undef,
2831 $biblio->{'abstract'}, $biblio->{'biblionumber'}
2832 ) if $biblio->{'biblionumber'};
2834 if ( $dbh->errstr || !$biblio->{'biblionumber'} ) {
2835 $error .= "ERROR in _koha_modify_biblio $query" . $dbh->errstr;
2838 return ( $biblio->{'biblionumber'}, $error );
2841 =head2 _koha_modify_biblioitem_nonmarc
2843 my ($biblioitemnumber,$error) = _koha_modify_biblioitem_nonmarc( $dbh, $biblioitem );
2847 sub _koha_modify_biblioitem_nonmarc
{
2848 my ( $dbh, $biblioitem ) = @_;
2851 # re-calculate the cn_sort, it may have changed
2852 my ($cn_sort) = GetClassSort
( $biblioitem->{'biblioitems.cn_source'}, $biblioitem->{'cn_class'}, $biblioitem->{'cn_item'} );
2854 my $query = "UPDATE biblioitems
2855 SET biblionumber = ?,
2861 publicationyear = ?,
2865 collectiontitle = ?,
2867 collectionvolume= ?,
2868 editionstatement= ?,
2869 editionresponsibility = ?,
2885 where biblioitemnumber = ?
2887 my $sth = $dbh->prepare($query);
2889 $biblioitem->{'biblionumber'}, $biblioitem->{'volume'}, $biblioitem->{'number'}, $biblioitem->{'itemtype'},
2890 $biblioitem->{'isbn'}, $biblioitem->{'issn'}, $biblioitem->{'publicationyear'}, $biblioitem->{'publishercode'},
2891 $biblioitem->{'volumedate'}, $biblioitem->{'volumedesc'}, $biblioitem->{'collectiontitle'}, $biblioitem->{'collectionissn'},
2892 $biblioitem->{'collectionvolume'}, $biblioitem->{'editionstatement'}, $biblioitem->{'editionresponsibility'}, $biblioitem->{'illus'},
2893 $biblioitem->{'pages'}, $biblioitem->{'bnotes'}, $biblioitem->{'size'}, $biblioitem->{'place'},
2894 $biblioitem->{'lccn'}, $biblioitem->{'url'}, $biblioitem->{'biblioitems.cn_source'}, $biblioitem->{'cn_class'},
2895 $biblioitem->{'cn_item'}, $biblioitem->{'cn_suffix'}, $cn_sort, $biblioitem->{'totalissues'},
2896 $biblioitem->{'ean'}, $biblioitem->{'agerestriction'}, $biblioitem->{'biblioitemnumber'}
2898 if ( $dbh->errstr ) {
2899 $error .= "ERROR in _koha_modify_biblioitem_nonmarc $query" . $dbh->errstr;
2902 return ( $biblioitem->{'biblioitemnumber'}, $error );
2905 =head2 _koha_add_biblioitem
2907 my ($biblioitemnumber,$error) = _koha_add_biblioitem( $dbh, $biblioitem );
2909 Internal function to add a biblioitem
2913 sub _koha_add_biblioitem
{
2914 my ( $dbh, $biblioitem ) = @_;
2917 my ($cn_sort) = GetClassSort
( $biblioitem->{'biblioitems.cn_source'}, $biblioitem->{'cn_class'}, $biblioitem->{'cn_item'} );
2918 my $query = "INSERT INTO biblioitems SET
2925 publicationyear = ?,
2929 collectiontitle = ?,
2931 collectionvolume= ?,
2932 editionstatement= ?,
2933 editionresponsibility = ?,
2950 my $sth = $dbh->prepare($query);
2952 $biblioitem->{'biblionumber'}, $biblioitem->{'volume'}, $biblioitem->{'number'}, $biblioitem->{'itemtype'},
2953 $biblioitem->{'isbn'}, $biblioitem->{'issn'}, $biblioitem->{'publicationyear'}, $biblioitem->{'publishercode'},
2954 $biblioitem->{'volumedate'}, $biblioitem->{'volumedesc'}, $biblioitem->{'collectiontitle'}, $biblioitem->{'collectionissn'},
2955 $biblioitem->{'collectionvolume'}, $biblioitem->{'editionstatement'}, $biblioitem->{'editionresponsibility'}, $biblioitem->{'illus'},
2956 $biblioitem->{'pages'}, $biblioitem->{'bnotes'}, $biblioitem->{'size'}, $biblioitem->{'place'},
2957 $biblioitem->{'lccn'}, $biblioitem->{'url'}, $biblioitem->{'biblioitems.cn_source'},
2958 $biblioitem->{'cn_class'}, $biblioitem->{'cn_item'}, $biblioitem->{'cn_suffix'}, $cn_sort,
2959 $biblioitem->{'totalissues'}, $biblioitem->{'ean'}, $biblioitem->{'agerestriction'}
2961 my $bibitemnum = $dbh->{'mysql_insertid'};
2963 if ( $dbh->errstr ) {
2964 $error .= "ERROR in _koha_add_biblioitem $query" . $dbh->errstr;
2968 return ( $bibitemnum, $error );
2971 =head2 _koha_delete_biblio
2973 $error = _koha_delete_biblio($dbh,$biblionumber);
2975 Internal sub for deleting from biblio table -- also saves to deletedbiblio
2977 C<$dbh> - the database handle
2979 C<$biblionumber> - the biblionumber of the biblio to be deleted
2983 # FIXME: add error handling
2985 sub _koha_delete_biblio
{
2986 my ( $dbh, $biblionumber ) = @_;
2988 # get all the data for this biblio
2989 my $sth = $dbh->prepare("SELECT * FROM biblio WHERE biblionumber=?");
2990 $sth->execute($biblionumber);
2992 # FIXME There is a transaction in _koha_delete_biblio_metadata
2993 # But actually all the following should be done inside a single transaction
2994 if ( my $data = $sth->fetchrow_hashref ) {
2996 # save the record in deletedbiblio
2997 # find the fields to save
2998 my $query = "INSERT INTO deletedbiblio SET ";
3000 foreach my $temp ( keys %$data ) {
3001 $query .= "$temp = ?,";
3002 push( @bind, $data->{$temp} );
3005 # replace the last , by ",?)"
3007 my $bkup_sth = $dbh->prepare($query);
3008 $bkup_sth->execute(@bind);
3011 _koha_delete_biblio_metadata
( $biblionumber );
3014 my $sth2 = $dbh->prepare("DELETE FROM biblio WHERE biblionumber=?");
3015 $sth2->execute($biblionumber);
3016 # update the timestamp (Bugzilla 7146)
3017 $sth2= $dbh->prepare("UPDATE deletedbiblio SET timestamp=NOW() WHERE biblionumber=?");
3018 $sth2->execute($biblionumber);
3025 =head2 _koha_delete_biblioitems
3027 $error = _koha_delete_biblioitems($dbh,$biblioitemnumber);
3029 Internal sub for deleting from biblioitems table -- also saves to deletedbiblioitems
3031 C<$dbh> - the database handle
3032 C<$biblionumber> - the biblioitemnumber of the biblioitem to be deleted
3036 # FIXME: add error handling
3038 sub _koha_delete_biblioitems
{
3039 my ( $dbh, $biblioitemnumber ) = @_;
3041 # get all the data for this biblioitem
3042 my $sth = $dbh->prepare("SELECT * FROM biblioitems WHERE biblioitemnumber=?");
3043 $sth->execute($biblioitemnumber);
3045 if ( my $data = $sth->fetchrow_hashref ) {
3047 # save the record in deletedbiblioitems
3048 # find the fields to save
3049 my $query = "INSERT INTO deletedbiblioitems SET ";
3051 foreach my $temp ( keys %$data ) {
3052 $query .= "$temp = ?,";
3053 push( @bind, $data->{$temp} );
3056 # replace the last , by ",?)"
3058 my $bkup_sth = $dbh->prepare($query);
3059 $bkup_sth->execute(@bind);
3062 # delete the biblioitem
3063 my $sth2 = $dbh->prepare("DELETE FROM biblioitems WHERE biblioitemnumber=?");
3064 $sth2->execute($biblioitemnumber);
3065 # update the timestamp (Bugzilla 7146)
3066 $sth2= $dbh->prepare("UPDATE deletedbiblioitems SET timestamp=NOW() WHERE biblioitemnumber=?");
3067 $sth2->execute($biblioitemnumber);
3074 =head2 _koha_delete_biblio_metadata
3076 $error = _koha_delete_biblio_metadata($biblionumber);
3078 C<$biblionumber> - the biblionumber of the biblio metadata to be deleted
3082 sub _koha_delete_biblio_metadata
{
3083 my ($biblionumber) = @_;
3085 my $dbh = C4
::Context
->dbh;
3086 my $schema = Koha
::Database
->new->schema;
3090 INSERT INTO deletedbiblio_metadata
(biblionumber
, format
, `schema`, metadata
)
3091 SELECT biblionumber
, format
, `schema`, metadata FROM biblio_metadata WHERE biblionumber
=?
3092 |, undef, $biblionumber );
3093 $dbh->do( q
|DELETE FROM biblio_metadata WHERE biblionumber
=?
|,
3094 undef, $biblionumber );
3099 =head1 UNEXPORTED FUNCTIONS
3101 =head2 ModBiblioMarc
3103 &ModBiblioMarc($newrec,$biblionumber,$frameworkcode);
3105 Add MARC XML data for a biblio to koha
3107 Function exported, but should NOT be used, unless you really know what you're doing
3112 # pass the MARC::Record to this function, and it will create the records in
3114 my ( $record, $biblionumber, $frameworkcode ) = @_;
3116 carp
'ModBiblioMarc passed an undefined record';
3120 # Clone record as it gets modified
3121 $record = $record->clone();
3122 my $dbh = C4
::Context
->dbh;
3123 my @fields = $record->fields();
3124 if ( !$frameworkcode ) {
3125 $frameworkcode = "";
3127 my $sth = $dbh->prepare("UPDATE biblio SET frameworkcode=? WHERE biblionumber=?");
3128 $sth->execute( $frameworkcode, $biblionumber );
3130 my $encoding = C4
::Context
->preference("marcflavour");
3132 # deal with UNIMARC field 100 (encoding) : create it if needed & set encoding to unicode
3133 if ( $encoding eq "UNIMARC" ) {
3134 my $defaultlanguage = C4
::Context
->preference("UNIMARCField100Language");
3135 $defaultlanguage = "fre" if (!$defaultlanguage || length($defaultlanguage) != 3);
3136 my $string = $record->subfield( 100, "a" );
3137 if ( ($string) && ( length( $record->subfield( 100, "a" ) ) == 36 ) ) {
3138 my $f100 = $record->field(100);
3139 $record->delete_field($f100);
3141 $string = POSIX
::strftime
( "%Y%m%d", localtime );
3143 $string = sprintf( "%-*s", 35, $string );
3144 substr ( $string, 22, 3, $defaultlanguage);
3146 substr( $string, 25, 3, "y50" );
3147 unless ( $record->subfield( 100, "a" ) ) {
3148 $record->insert_fields_ordered( MARC
::Field
->new( 100, "", "", "a" => $string ) );
3152 #enhancement 5374: update transaction date (005) for marc21/unimarc
3153 if($encoding =~ /MARC21|UNIMARC/) {
3154 my @a= (localtime) [5,4,3,2,1,0]; $a[0]+=1900; $a[1]++;
3155 # YY MM DD HH MM SS (update year and month)
3156 my $f005= $record->field('005');
3157 $f005->update(sprintf("%4d%02d%02d%02d%02d%04.1f",@a)) if $f005;
3161 biblionumber
=> $biblionumber,
3162 format
=> 'marcxml',
3163 schema
=> C4
::Context
->preference('marcflavour'),
3165 $record->as_usmarc; # Bug 20126/10455 This triggers field length calculation
3167 my $m_rs = Koha
::Biblio
::Metadatas
->find($metadata) //
3168 Koha
::Biblio
::Metadata
->new($metadata);
3170 my $userenv = C4
::Context
->userenv;
3172 my $borrowernumber = $userenv->{number
};
3173 my $borrowername = join ' ', map { $_ // q{} } @
$userenv{qw(firstname surname)};
3174 unless ($m_rs->in_storage) {
3175 Koha
::Util
::MARC
::set_marc_field
($record, C4
::Context
->preference('MarcFieldForCreatorId'), $borrowernumber);
3176 Koha
::Util
::MARC
::set_marc_field
($record, C4
::Context
->preference('MarcFieldForCreatorName'), $borrowername);
3178 Koha
::Util
::MARC
::set_marc_field
($record, C4
::Context
->preference('MarcFieldForModifierId'), $borrowernumber);
3179 Koha
::Util
::MARC
::set_marc_field
($record, C4
::Context
->preference('MarcFieldForModifierName'), $borrowername);
3182 $m_rs->metadata( $record->as_xml_record($encoding) );
3185 ModZebra
( $biblionumber, "specialUpdate", "biblioserver" );
3187 return $biblionumber;
3190 =head2 CountBiblioInOrders
3192 $count = &CountBiblioInOrders( $biblionumber);
3194 This function return count of biblios in orders with $biblionumber
3198 sub CountBiblioInOrders
{
3199 my ($biblionumber) = @_;
3200 my $dbh = C4
::Context
->dbh;
3201 my $query = "SELECT count(*)
3203 WHERE biblionumber=? AND datecancellationprinted IS NULL";
3204 my $sth = $dbh->prepare($query);
3205 $sth->execute($biblionumber);
3206 my $count = $sth->fetchrow;
3210 =head2 prepare_host_field
3212 $marcfield = prepare_host_field( $hostbiblioitem, $marcflavour );
3213 Generate the host item entry for an analytic child entry
3217 sub prepare_host_field
{
3218 my ( $hostbiblio, $marcflavour ) = @_;
3219 $marcflavour ||= C4
::Context
->preference('marcflavour');
3220 my $host = GetMarcBiblio
({ biblionumber
=> $hostbiblio });
3221 # unfortunately as_string does not 'do the right thing'
3222 # if field returns undef
3226 if ( $marcflavour eq 'MARC21' || $marcflavour eq 'NORMARC' ) {
3227 if ( $field = $host->field('100') || $host->field('110') || $host->field('11') ) {
3228 my $s = $field->as_string('ab');
3233 if ( $field = $host->field('245') ) {
3234 my $s = $field->as_string('a');
3239 if ( $field = $host->field('260') ) {
3240 my $s = $field->as_string('abc');
3245 if ( $field = $host->field('240') ) {
3246 my $s = $field->as_string();
3251 if ( $field = $host->field('022') ) {
3252 my $s = $field->as_string('a');
3257 if ( $field = $host->field('020') ) {
3258 my $s = $field->as_string('a');
3263 if ( $field = $host->field('001') ) {
3264 $sfd{w
} = $field->data(),;
3266 $host_field = MARC
::Field
->new( 773, '0', ' ', %sfd );
3269 elsif ( $marcflavour eq 'UNIMARC' ) {
3271 if ( $field = $host->field('700') || $host->field('710') || $host->field('720') ) {
3272 my $s = $field->as_string('ab');
3278 if ( $field = $host->field('200') ) {
3279 my $s = $field->as_string('a');
3284 #place of publicaton
3285 if ( $field = $host->field('210') ) {
3286 my $s = $field->as_string('a');
3291 #date of publication
3292 if ( $field = $host->field('210') ) {
3293 my $s = $field->as_string('d');
3299 if ( $field = $host->field('205') ) {
3300 my $s = $field->as_string();
3306 if ( $field = $host->field('856') ) {
3307 my $s = $field->as_string('u');
3313 if ( $field = $host->field('011') ) {
3314 my $s = $field->as_string('a');
3320 if ( $field = $host->field('010') ) {
3321 my $s = $field->as_string('a');
3326 if ( $field = $host->field('001') ) {
3327 $sfd{0} = $field->data(),;
3329 $host_field = MARC
::Field
->new( 461, '0', ' ', %sfd );
3336 =head2 UpdateTotalIssues
3338 UpdateTotalIssues($biblionumber, $increase, [$value])
3340 Update the total issue count for a particular bib record.
3344 =item C<$biblionumber> is the biblionumber of the bib to update
3346 =item C<$increase> is the amount to increase (or decrease) the total issues count by
3348 =item C<$value> is the absolute value that total issues count should be set to. If provided, C<$increase> is ignored.
3354 sub UpdateTotalIssues
{
3355 my ($biblionumber, $increase, $value) = @_;
3358 my $record = GetMarcBiblio
({ biblionumber
=> $biblionumber });
3360 carp
"UpdateTotalIssues could not get biblio record";
3363 my $biblio = Koha
::Biblios
->find( $biblionumber );
3365 carp
"UpdateTotalIssues could not get datas of biblio";
3368 my $biblioitem = $biblio->biblioitem;
3369 my ($totalissuestag, $totalissuessubfield) = GetMarcFromKohaField
( 'biblioitems.totalissues' );
3370 unless ($totalissuestag) {
3371 return 1; # There is nothing to do
3374 if (defined $value) {
3375 $totalissues = $value;
3377 $totalissues = $biblioitem->totalissues + $increase;
3380 my $field = $record->field($totalissuestag);
3381 if (defined $field) {
3382 $field->update( $totalissuessubfield => $totalissues );
3384 $field = MARC
::Field
->new($totalissuestag, '0', '0',
3385 $totalissuessubfield => $totalissues);
3386 $record->insert_grouped_field($field);
3389 return ModBiblio
($record, $biblionumber, $biblio->frameworkcode);
3394 &RemoveAllNsb($record);
3396 Removes all nsb/nse chars from a record
3403 carp
'RemoveAllNsb called with undefined record';
3407 SetUTF8Flag
($record);
3409 foreach my $field ($record->fields()) {
3410 if ($field->is_control_field()) {
3411 $field->update(nsb_clean
($field->data()));
3413 my @subfields = $field->subfields();
3415 foreach my $subfield (@subfields) {
3416 push @new_subfields, $subfield->[0] => nsb_clean
($subfield->[1]);
3418 if (scalar(@new_subfields) > 0) {
3421 $new_field = MARC
::Field
->new(
3423 $field->indicator(1),
3424 $field->indicator(2),
3429 warn "error in RemoveAllNsb : $@";
3431 $field->replace_with($new_field);
3443 =head2 _after_biblio_action_hooks
3445 Helper method that takes care of calling all plugin hooks
3449 sub _after_biblio_action_hooks
{
3452 my $biblio_id = $args->{biblio_id
};
3453 my $action = $args->{action
};
3455 if ( C4
::Context
->preference('UseKohaPlugins') && C4
::Context
->config("enable_plugins") ) {
3457 my @plugins = Koha
::Plugins
->new->GetPlugins({
3458 method
=> 'after_biblio_action',
3463 my $biblio = Koha
::Biblios
->find( $biblio_id );
3465 foreach my $plugin ( @plugins ) {
3467 $plugin->after_biblio_action({ action
=> $action, biblio
=> $biblio, biblio_id
=> $biblio_id });
3481 Koha Development Team <http://koha-community.org/>
3483 Paul POULAIN paul.poulain@free.fr
3485 Joshua Ferraro jmf@liblime.com