3 # Copyright 2000-2002 Katipo Communications
4 # Copyright 2010 BibLibre
5 # Copyright 2011 Equinox Software, Inc.
7 # This file is part of Koha.
9 # Koha is free software; you can redistribute it and/or modify it
10 # under the terms of the GNU General Public License as published by
11 # the Free Software Foundation; either version 3 of the License, or
12 # (at your option) any later version.
14 # Koha is distributed in the hope that it will be useful, but
15 # WITHOUT ANY WARRANTY; without even the implied warranty of
16 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17 # GNU General Public License for more details.
19 # You should have received a copy of the GNU General Public License
20 # along with Koha; if not, see <http://www.gnu.org/licenses>.
25 use Encode qw( decode is_utf8 );
27 use MARC::File::USMARC;
29 use POSIX qw(strftime);
30 use Module::Load::Conditional qw(can_load);
33 use C4::Log; # logaction
42 use Koha::Authority::Types;
43 use Koha::Acquisition::Currencies;
44 use Koha::Biblio::Metadata;
45 use Koha::Biblio::Metadatas;
48 use Koha::SearchEngine;
51 use vars qw(@ISA @EXPORT);
52 use vars qw($debug $cgi_debug);
57 @ISA = qw( Exporter );
72 GetBiblioItemByBiblioNumber
73 GetBiblionumberFromItemnumber
95 &GetAuthorisedValueDesc
97 &IsMarcStructureInternal
99 &GetMarcSubfieldStructureFromKohaField
109 # To modify something
117 # To delete something
122 # To link headings in a bib record
123 # to authority records.
126 &LinkBibHeadingsToAuthorities
130 # those functions are exported but should not be used
131 # they are useful in a few circumstances, so they are exported,
132 # but don't use them unless you are a core developer ;-)
148 C4::Biblio - cataloging management functions
152 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:
156 =item 1. in the biblio,biblioitems,items, etc tables, which are limited to a one-to-one mapping to underlying MARC data
158 =item 2. as raw MARC in the Zebra index and storage engine
160 =item 3. as MARC XML in biblio_metadata.metadata
164 In the 3.0 version of Koha, the authoritative record-level information is in biblio_metadata.metadata
166 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.
170 =item 1. Compared with MySQL, Zebra is slow to update an index for small data changes -- especially for proc-intensive operations like circulation
172 =item 2. Zebra's index has been known to crash and a backup of the data is necessary to rebuild it in such cases
176 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:
180 =item 1. Add*/Mod*/Del*/ - high-level external functions suitable for being called from external scripts to manage the collection
182 =item 2. _koha_* - low-level internal functions for managing the koha tables
184 =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.
186 =item 4. Zebra functions used to update the Zebra index
188 =item 5. internal helper functions such as char_decode, checkitems, etc. Some of these probably belong in Koha.pm
192 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 :
196 =item 1. save datas in biblio and biblioitems table, that gives us a biblionumber and a biblioitemnumber
198 =item 2. add the biblionumber and biblioitemnumber into the MARC records
200 =item 3. save the marc record
204 =head1 EXPORTED FUNCTIONS
208 ($biblionumber,$biblioitemnumber) = AddBiblio($record,$frameworkcode);
210 Exported function (core API) for adding a new biblio to koha.
212 The first argument is a C<MARC::Record> object containing the
213 bib to add, while the second argument is the desired MARC
216 This function also accepts a third, optional argument: a hashref
217 to additional options. The only defined option is C<defer_marc_save>,
218 which if present and mapped to a true value, causes C<AddBiblio>
219 to omit the call to save the MARC in C<biblio_metadata.metadata>
220 This option is provided B<only>
221 for the use of scripts such as C<bulkmarcimport.pl> that may need
222 to do some manipulation of the MARC record for item parsing before
223 saving it and which cannot afford the performance hit of saving
224 the MARC record twice. Consequently, do not use that option
225 unless you can guarantee that C<ModBiblioMarc> will be called.
231 my $frameworkcode = shift;
232 my $options = @_ ? shift : undef;
233 my $defer_marc_save = 0;
235 carp('AddBiblio called with undefined record');
238 if ( defined $options and exists $options->{'defer_marc_save'} and $options->{'defer_marc_save'} ) {
239 $defer_marc_save = 1;
242 my ( $biblionumber, $biblioitemnumber, $error );
243 my $dbh = C4::Context->dbh;
245 # transform the data into koha-table style data
246 SetUTF8Flag($record);
247 my $olddata = TransformMarcToKoha( $record, $frameworkcode );
248 ( $biblionumber, $error ) = _koha_add_biblio( $dbh, $olddata, $frameworkcode );
249 $olddata->{'biblionumber'} = $biblionumber;
250 ( $biblioitemnumber, $error ) = _koha_add_biblioitem( $dbh, $olddata );
252 _koha_marc_update_bib_ids( $record, $frameworkcode, $biblionumber, $biblioitemnumber );
254 # update MARC subfield that stores biblioitems.cn_sort
255 _koha_marc_update_biblioitem_cn_sort( $record, $olddata, $frameworkcode );
258 ModBiblioMarc( $record, $biblionumber, $frameworkcode ) unless $defer_marc_save;
260 # update OAI-PMH sets
261 if(C4::Context->preference("OAI-PMH:AutoUpdateSets")) {
262 C4::OAI::Sets::UpdateOAISetsBiblio($biblionumber, $record);
265 logaction( "CATALOGUING", "ADD", $biblionumber, "biblio" ) if C4::Context->preference("CataloguingLog");
266 return ( $biblionumber, $biblioitemnumber );
271 ModBiblio( $record,$biblionumber,$frameworkcode);
273 Replace an existing bib record identified by C<$biblionumber>
274 with one supplied by the MARC::Record object C<$record>. The embedded
275 item, biblioitem, and biblionumber fields from the previous
276 version of the bib record replace any such fields of those tags that
277 are present in C<$record>. Consequently, ModBiblio() is not
278 to be used to try to modify item records.
280 C<$frameworkcode> specifies the MARC framework to use
281 when storing the modified bib record; among other things,
282 this controls how MARC fields get mapped to display columns
283 in the C<biblio> and C<biblioitems> tables, as well as
284 which fields are used to store embedded item, biblioitem,
285 and biblionumber data for indexing.
287 Returns 1 on success 0 on failure
292 my ( $record, $biblionumber, $frameworkcode ) = @_;
294 carp 'No record passed to ModBiblio';
298 if ( C4::Context->preference("CataloguingLog") ) {
299 my $newrecord = GetMarcBiblio($biblionumber);
300 logaction( "CATALOGUING", "MODIFY", $biblionumber, "biblio BEFORE=>" . $newrecord->as_formatted );
303 # Cleaning up invalid fields must be done early or SetUTF8Flag is liable to
304 # throw an exception which probably won't be handled.
305 foreach my $field ($record->fields()) {
306 if (! $field->is_control_field()) {
307 if (scalar($field->subfields()) == 0 || (scalar($field->subfields()) == 1 && $field->subfield('9'))) {
308 $record->delete_field($field);
313 SetUTF8Flag($record);
314 my $dbh = C4::Context->dbh;
316 $frameworkcode = "" if !$frameworkcode || $frameworkcode eq "Default"; # XXX
318 _strip_item_fields($record, $frameworkcode);
320 # update biblionumber and biblioitemnumber in MARC
321 # FIXME - this is assuming a 1 to 1 relationship between
322 # biblios and biblioitems
323 my $sth = $dbh->prepare("select biblioitemnumber from biblioitems where biblionumber=?");
324 $sth->execute($biblionumber);
325 my ($biblioitemnumber) = $sth->fetchrow;
327 _koha_marc_update_bib_ids( $record, $frameworkcode, $biblionumber, $biblioitemnumber );
329 # load the koha-table data object
330 my $oldbiblio = TransformMarcToKoha( $record, $frameworkcode );
332 # update MARC subfield that stores biblioitems.cn_sort
333 _koha_marc_update_biblioitem_cn_sort( $record, $oldbiblio, $frameworkcode );
335 # update the MARC record (that now contains biblio and items) with the new record data
336 &ModBiblioMarc( $record, $biblionumber, $frameworkcode );
338 # modify the other koha tables
339 _koha_modify_biblio( $dbh, $oldbiblio, $frameworkcode );
340 _koha_modify_biblioitem_nonmarc( $dbh, $oldbiblio );
342 # update OAI-PMH sets
343 if(C4::Context->preference("OAI-PMH:AutoUpdateSets")) {
344 C4::OAI::Sets::UpdateOAISetsBiblio($biblionumber, $record);
350 =head2 _strip_item_fields
352 _strip_item_fields($record, $frameworkcode)
354 Utility routine to remove item tags from a
359 sub _strip_item_fields {
361 my $frameworkcode = shift;
362 # get the items before and append them to the biblio before updating the record, atm we just have the biblio
363 my ( $itemtag, $itemsubfield ) = GetMarcFromKohaField( "items.itemnumber", $frameworkcode );
365 # delete any item fields from incoming record to avoid
366 # duplication or incorrect data - use AddItem() or ModItem()
368 foreach my $field ( $record->field($itemtag) ) {
369 $record->delete_field($field);
375 my $error = &DelBiblio($biblionumber);
377 Exported function (core API) for deleting a biblio in koha.
378 Deletes biblio record from Zebra and Koha tables (biblio & biblioitems)
379 Also backs it up to deleted* tables.
380 Checks to make sure that the biblio has no items attached.
382 C<$error> : undef unless an error occurs
387 my ($biblionumber) = @_;
388 my $dbh = C4::Context->dbh;
389 my $error; # for error handling
391 # First make sure this biblio has no items attached
392 my $sth = $dbh->prepare("SELECT itemnumber FROM items WHERE biblionumber=?");
393 $sth->execute($biblionumber);
394 if ( my $itemnumber = $sth->fetchrow ) {
396 # Fix this to use a status the template can understand
397 $error .= "This Biblio has items attached, please delete them first before deleting this biblio ";
400 return $error if $error;
402 # We delete attached subscriptions
404 my $subscriptions = C4::Serials::GetFullSubscriptionsFromBiblionumber($biblionumber);
405 foreach my $subscription (@$subscriptions) {
406 C4::Serials::DelSubscription( $subscription->{subscriptionid} );
409 # We delete any existing holds
410 my $biblio = Koha::Biblios->find( $biblionumber );
411 my $holds = $biblio->holds;
412 require C4::Reserves;
413 while ( my $hold = $holds->next ) {
414 C4::Reserves::CancelReserve({ reserve_id => $hold->reserve_id }); # TODO Replace with $hold->cancel
417 # Delete in Zebra. Be careful NOT to move this line after _koha_delete_biblio
418 # for at least 2 reasons :
419 # - if something goes wrong, the biblio may be deleted from Koha but not from zebra
420 # 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)
421 ModZebra( $biblionumber, "recordDelete", "biblioserver" );
423 # delete biblioitems and items from Koha tables and save in deletedbiblioitems,deleteditems
424 $sth = $dbh->prepare("SELECT biblioitemnumber FROM biblioitems WHERE biblionumber=?");
425 $sth->execute($biblionumber);
426 while ( my $biblioitemnumber = $sth->fetchrow ) {
428 # delete this biblioitem
429 $error = _koha_delete_biblioitems( $dbh, $biblioitemnumber );
430 return $error if $error;
434 # delete biblio from Koha tables and save in deletedbiblio
435 # must do this *after* _koha_delete_biblioitems, otherwise
436 # delete cascade will prevent deletedbiblioitems rows
437 # from being generated by _koha_delete_biblioitems
438 $error = _koha_delete_biblio( $dbh, $biblionumber );
440 logaction( "CATALOGUING", "DELETE", $biblionumber, "biblio" ) if C4::Context->preference("CataloguingLog");
446 =head2 BiblioAutoLink
448 my $headings_linked = BiblioAutoLink($record, $frameworkcode)
450 Automatically links headings in a bib record to authorities.
452 Returns the number of headings changed
458 my $frameworkcode = shift;
460 carp('Undefined record passed to BiblioAutoLink');
463 my ( $num_headings_changed, %results );
466 "C4::Linker::" . ( C4::Context->preference("LinkerModule") || 'Default' );
467 unless ( can_load( modules => { $linker_module => undef } ) ) {
468 $linker_module = 'C4::Linker::Default';
469 unless ( can_load( modules => { $linker_module => undef } ) ) {
474 my $linker = $linker_module->new(
475 { 'options' => C4::Context->preference("LinkerOptions") } );
476 my ( $headings_changed, undef ) =
477 LinkBibHeadingsToAuthorities( $linker, $record, $frameworkcode, C4::Context->preference("CatalogModuleRelink") || '' );
478 # By default we probably don't want to relink things when cataloging
479 return $headings_changed;
482 =head2 LinkBibHeadingsToAuthorities
484 my $num_headings_changed, %results = LinkBibHeadingsToAuthorities($linker, $marc, $frameworkcode, [$allowrelink]);
486 Links bib headings to authority records by checking
487 each authority-controlled field in the C<MARC::Record>
488 object C<$marc>, looking for a matching authority record,
489 and setting the linking subfield $9 to the ID of that
492 If $allowrelink is false, existing authids will never be
493 replaced, regardless of the values of LinkerKeepStale and
496 Returns the number of heading links changed in the
501 sub LinkBibHeadingsToAuthorities {
504 my $frameworkcode = shift;
505 my $allowrelink = shift;
508 carp 'LinkBibHeadingsToAuthorities called on undefined bib record';
512 require C4::AuthoritiesMarc;
514 $allowrelink = 1 unless defined $allowrelink;
515 my $num_headings_changed = 0;
516 foreach my $field ( $bib->fields() ) {
517 my $heading = C4::Heading->new_from_bib_field( $field, $frameworkcode );
518 next unless defined $heading;
521 my $current_link = $field->subfield('9');
523 if ( defined $current_link && (!$allowrelink || !C4::Context->preference('LinkerRelink')) )
525 $results{'linked'}->{ $heading->display_form() }++;
529 my ( $authid, $fuzzy ) = $linker->get_link($heading);
531 $results{ $fuzzy ? 'fuzzy' : 'linked' }
532 ->{ $heading->display_form() }++;
533 next if defined $current_link and $current_link == $authid;
535 $field->delete_subfield( code => '9' ) if defined $current_link;
536 $field->add_subfields( '9', $authid );
537 $num_headings_changed++;
540 if ( defined $current_link
541 && (!$allowrelink || C4::Context->preference('LinkerKeepStale')) )
543 $results{'fuzzy'}->{ $heading->display_form() }++;
545 elsif ( C4::Context->preference('AutoCreateAuthorities') ) {
546 if ( _check_valid_auth_link( $current_link, $field ) ) {
547 $results{'linked'}->{ $heading->display_form() }++;
550 my $authority_type = Koha::Authority::Types->find( $heading->auth_type() );
551 my $marcrecordauth = MARC::Record->new();
552 if ( C4::Context->preference('marcflavour') eq 'MARC21' ) {
553 $marcrecordauth->leader(' nz a22 o 4500');
554 SetMarcUnicodeFlag( $marcrecordauth, 'MARC21' );
556 $field->delete_subfield( code => '9' )
557 if defined $current_link;
559 MARC::Field->new( $authority_type->auth_tag_to_report,
560 '', '', "a" => "" . $field->subfield('a') );
562 $authfield->add_subfields( $_->[0] => $_->[1] )
563 if ( $_->[0] =~ /[A-z]/ && $_->[0] ne "a" )
564 } $field->subfields();
565 $marcrecordauth->insert_fields_ordered($authfield);
567 # bug 2317: ensure new authority knows it's using UTF-8; currently
568 # only need to do this for MARC21, as MARC::Record->as_xml_record() handles
569 # automatically for UNIMARC (by not transcoding)
570 # FIXME: AddAuthority() instead should simply explicitly require that the MARC::Record
571 # use UTF-8, but as of 2008-08-05, did not want to introduce that kind
572 # of change to a core API just before the 3.0 release.
574 if ( C4::Context->preference('marcflavour') eq 'MARC21' ) {
575 $marcrecordauth->insert_fields_ordered(
578 'a' => "Machine generated authority record."
582 $bib->author() . ", "
583 . $bib->title_proper() . ", "
584 . $bib->publication_date() . " ";
585 $cite =~ s/^[\s\,]*//;
586 $cite =~ s/[\s\,]*$//;
589 . C4::Context->preference('MARCOrgCode') . ")"
590 . $bib->subfield( '999', 'c' ) . ": "
592 $marcrecordauth->insert_fields_ordered(
593 MARC::Field->new( '670', '', '', 'a' => $cite ) );
596 # warn "AUTH RECORD ADDED : ".$marcrecordauth->as_formatted;
599 C4::AuthoritiesMarc::AddAuthority( $marcrecordauth, '',
600 $heading->auth_type() );
601 $field->add_subfields( '9', $authid );
602 $num_headings_changed++;
603 $linker->update_cache($heading, $authid);
604 $results{'added'}->{ $heading->display_form() }++;
607 elsif ( defined $current_link ) {
608 if ( _check_valid_auth_link( $current_link, $field ) ) {
609 $results{'linked'}->{ $heading->display_form() }++;
612 $field->delete_subfield( code => '9' );
613 $num_headings_changed++;
614 $results{'unlinked'}->{ $heading->display_form() }++;
618 $results{'unlinked'}->{ $heading->display_form() }++;
623 return $num_headings_changed, \%results;
626 =head2 _check_valid_auth_link
628 if ( _check_valid_auth_link($authid, $field) ) {
632 Check whether the specified heading-auth link is valid without reference
633 to Zebra. Ideally this code would be in C4::Heading, but that won't be
634 possible until we have de-cycled C4::AuthoritiesMarc, so this is the
639 sub _check_valid_auth_link {
640 my ( $authid, $field ) = @_;
642 require C4::AuthoritiesMarc;
644 my $authorized_heading =
645 C4::AuthoritiesMarc::GetAuthorizedHeading( { 'authid' => $authid } ) || '';
647 return ($field->as_string('abcdefghijklmnopqrstuvwxyz') eq $authorized_heading);
650 =head2 GetRecordValue
652 my $values = GetRecordValue($field, $record, $frameworkcode);
654 Get MARC fields from a keyword defined in fieldmapping table.
659 my ( $field, $record, $frameworkcode ) = @_;
662 carp 'GetRecordValue called with undefined record';
665 my $dbh = C4::Context->dbh;
667 my $sth = $dbh->prepare('SELECT fieldcode, subfieldcode FROM fieldmapping WHERE frameworkcode = ? AND field = ?');
668 $sth->execute( $frameworkcode, $field );
672 while ( my $row = $sth->fetchrow_hashref ) {
673 foreach my $field ( $record->field( $row->{fieldcode} ) ) {
674 if ( ( $row->{subfieldcode} ne "" && $field->subfield( $row->{subfieldcode} ) ) ) {
675 foreach my $subfield ( $field->subfield( $row->{subfieldcode} ) ) {
676 push @result, { 'subfield' => $subfield };
679 } elsif ( $row->{subfieldcode} eq "" ) {
680 push @result, { 'subfield' => $field->as_string() };
690 $data = &GetBiblioData($biblionumber);
692 Returns information about the book with the given biblionumber.
693 C<&GetBiblioData> returns a reference-to-hash. The keys are the fields in
694 the C<biblio> and C<biblioitems> tables in the
697 In addition, C<$data-E<gt>{subject}> is the list of the book's
698 subjects, separated by C<" , "> (space, comma, space).
699 If there are multiple biblioitems with the given biblionumber, only
700 the first one is considered.
706 my $dbh = C4::Context->dbh;
708 my $query = " SELECT * , biblioitems.notes AS bnotes, itemtypes.notforloan as bi_notforloan, biblio.notes
710 LEFT JOIN biblioitems ON biblio.biblionumber = biblioitems.biblionumber
711 LEFT JOIN itemtypes ON biblioitems.itemtype = itemtypes.itemtype
712 WHERE biblio.biblionumber = ?";
714 my $sth = $dbh->prepare($query);
715 $sth->execute($bibnum);
717 $data = $sth->fetchrow_hashref;
721 } # sub GetBiblioData
723 =head2 &GetBiblioItemData
725 $itemdata = &GetBiblioItemData($biblioitemnumber);
727 Looks up the biblioitem with the given biblioitemnumber. Returns a
728 reference-to-hash. The keys are the fields from the C<biblio>,
729 C<biblioitems>, and C<itemtypes> tables in the Koha database, except
730 that C<biblioitems.notes> is given as C<$itemdata-E<gt>{bnotes}>.
735 sub GetBiblioItemData {
736 my ($biblioitemnumber) = @_;
737 my $dbh = C4::Context->dbh;
738 my $query = "SELECT *,biblioitems.notes AS bnotes
739 FROM biblio LEFT JOIN biblioitems on biblio.biblionumber=biblioitems.biblionumber ";
740 unless ( C4::Context->preference('item-level_itypes') ) {
741 $query .= "LEFT JOIN itemtypes on biblioitems.itemtype=itemtypes.itemtype ";
743 $query .= " WHERE biblioitemnumber = ? ";
744 my $sth = $dbh->prepare($query);
746 $sth->execute($biblioitemnumber);
747 $data = $sth->fetchrow_hashref;
750 } # sub &GetBiblioItemData
752 =head2 GetBiblioItemByBiblioNumber
754 NOTE : This function has been copy/paste from C4/Biblio.pm from head before zebra integration.
758 sub GetBiblioItemByBiblioNumber {
759 my ($biblionumber) = @_;
760 my $dbh = C4::Context->dbh;
761 my $sth = $dbh->prepare("Select * FROM biblioitems WHERE biblionumber = ?");
765 $sth->execute($biblionumber);
767 while ( my $data = $sth->fetchrow_hashref ) {
768 push @results, $data;
775 =head2 GetBiblionumberFromItemnumber
780 sub GetBiblionumberFromItemnumber {
781 my ($itemnumber) = @_;
782 my $dbh = C4::Context->dbh;
783 my $sth = $dbh->prepare("Select biblionumber FROM items WHERE itemnumber = ?");
785 $sth->execute($itemnumber);
786 my ($result) = $sth->fetchrow;
792 $isbd = &GetISBDView({
793 'record' => $marc_record,
794 'template' => $interface, # opac/intranet
795 'framework' => $framework,
798 Return the ISBD view which can be included in opac and intranet
805 # Expecting record WITH items.
806 my $record = $params->{record};
807 return unless defined $record;
809 my $template = $params->{template} // q{};
810 my $sysprefname = $template eq 'opac' ? 'opacisbd' : 'isbd';
811 my $framework = $params->{framework};
812 my $itemtype = $framework;
813 my ( $holdingbrtagf, $holdingbrtagsubf ) = &GetMarcFromKohaField( "items.holdingbranch", $itemtype );
814 my $tagslib = &GetMarcStructure( 1, $itemtype, { unsafe => 1 } );
816 my $ISBD = C4::Context->preference($sysprefname);
821 foreach my $isbdfield ( split( /#/, $bloc ) ) {
823 # $isbdfield= /(.?.?.?)/;
824 $isbdfield =~ /(\d\d\d)([^\|])?\|(.*)\|(.*)\|(.*)/;
825 my $fieldvalue = $1 || 0;
826 my $subfvalue = $2 || "";
828 my $analysestring = $4;
831 # warn "==> $1 / $2 / $3 / $4";
832 # my $fieldvalue=substr($isbdfield,0,3);
833 if ( $fieldvalue > 0 ) {
834 my $hasputtextbefore = 0;
835 my @fieldslist = $record->field($fieldvalue);
836 @fieldslist = sort { $a->subfield($holdingbrtagsubf) cmp $b->subfield($holdingbrtagsubf) } @fieldslist if ( $fieldvalue eq $holdingbrtagf );
838 # warn "ERROR IN ISBD DEFINITION at : $isbdfield" unless $fieldvalue;
839 # warn "FV : $fieldvalue";
840 if ( $subfvalue ne "" ) {
841 # OPAC hidden subfield
843 if ( ( $template eq 'opac' )
844 && ( $tagslib->{$fieldvalue}->{$subfvalue}->{'hidden'} || 0 ) > 0 );
845 foreach my $field (@fieldslist) {
846 foreach my $subfield ( $field->subfield($subfvalue) ) {
847 my $calculated = $analysestring;
848 my $tag = $field->tag();
851 my $subfieldvalue = GetAuthorisedValueDesc( $tag, $subfvalue, $subfield, '', $tagslib );
852 my $tagsubf = $tag . $subfvalue;
853 $calculated =~ s/\{(.?.?.?.?)$tagsubf(.*?)\}/$1$subfieldvalue$2\{$1$tagsubf$2\}/g;
854 if ( $template eq "opac" ) { $calculated =~ s#/cgi-bin/koha/[^/]+/([^.]*.pl\?.*)$#opac-$1#g; }
856 # field builded, store the result
857 if ( $calculated && !$hasputtextbefore ) { # put textbefore if not done
858 $blocres .= $textbefore;
859 $hasputtextbefore = 1;
862 # remove punctuation at start
863 $calculated =~ s/^( |;|:|\.|-)*//g;
864 $blocres .= $calculated;
869 $blocres .= $textafter if $hasputtextbefore;
871 foreach my $field (@fieldslist) {
872 my $calculated = $analysestring;
873 my $tag = $field->tag();
876 my @subf = $field->subfields;
877 for my $i ( 0 .. $#subf ) {
878 my $valuecode = $subf[$i][1];
879 my $subfieldcode = $subf[$i][0];
880 # OPAC hidden subfield
882 if ( ( $template eq 'opac' )
883 && ( $tagslib->{$fieldvalue}->{$subfieldcode}->{'hidden'} || 0 ) > 0 );
884 my $subfieldvalue = GetAuthorisedValueDesc( $tag, $subf[$i][0], $subf[$i][1], '', $tagslib );
885 my $tagsubf = $tag . $subfieldcode;
887 $calculated =~ s/ # replace all {{}} codes by the value code.
888 \{\{$tagsubf\}\} # catch the {{actualcode}}
890 $valuecode # replace by the value code
893 $calculated =~ s/\{(.?.?.?.?)$tagsubf(.*?)\}/$1$subfieldvalue$2\{$1$tagsubf$2\}/g;
894 if ( $template eq "opac" ) { $calculated =~ s#/cgi-bin/koha/[^/]+/([^.]*.pl\?.*)$#opac-$1#g; }
897 # field builded, store the result
898 if ( $calculated && !$hasputtextbefore ) { # put textbefore if not done
899 $blocres .= $textbefore;
900 $hasputtextbefore = 1;
903 # remove punctuation at start
904 $calculated =~ s/^( |;|:|\.|-)*//g;
905 $blocres .= $calculated;
908 $blocres .= $textafter if $hasputtextbefore;
911 $blocres .= $isbdfield;
916 $res =~ s/\{(.*?)\}//g;
918 $res =~ s/\n/<br\/>/g;
928 my $biblio = &GetBiblio($biblionumber);
933 my ($biblionumber) = @_;
934 my $dbh = C4::Context->dbh;
935 my $sth = $dbh->prepare("SELECT * FROM biblio WHERE biblionumber = ?");
938 $sth->execute($biblionumber);
939 if ( my $data = $sth->fetchrow_hashref ) {
945 =head2 GetBiblioItemInfosOf
947 GetBiblioItemInfosOf(@biblioitemnumbers);
951 sub GetBiblioItemInfosOf {
952 my @biblioitemnumbers = @_;
954 my $biblioitemnumber_values = @biblioitemnumbers ? join( ',', @biblioitemnumbers ) : "''";
956 my $dbh = C4::Context->dbh;
958 SELECT biblioitemnumber,
962 WHERE biblioitemnumber IN ($biblioitemnumber_values)
964 return $dbh->selectall_hashref($query, 'biblioitemnumber');
967 =head1 FUNCTIONS FOR HANDLING MARC MANAGEMENT
969 =head2 IsMarcStructureInternal
971 my $tagslib = C4::Biblio::GetMarcStructure();
972 for my $tag ( sort keys %$tagslib ) {
974 for my $subfield ( sort keys %{ $tagslib->{$tag} } ) {
975 next if IsMarcStructureInternal($tagslib->{$tag}{$subfield});
980 GetMarcStructure creates keys (lib, tab, mandatory, repeatable) for a display purpose.
981 These different values should not be processed as valid subfields.
985 sub IsMarcStructureInternal {
986 my ( $subfield ) = @_;
987 return ref $subfield ? 0 : 1;
990 =head2 GetMarcStructure
992 $res = GetMarcStructure($forlibrarian, $frameworkcode, [ $params ]);
994 Returns a reference to a big hash of hash, with the Marc structure for the given frameworkcode
995 $forlibrarian :if set to 1, the MARC descriptions are the librarians ones, otherwise it's the public (OPAC) ones
996 $frameworkcode : the framework code to read
997 $params allows you to pass { unsafe => 1 } for better performance.
999 Note: If you call GetMarcStructure with unsafe => 1, do not modify or
1000 even autovivify its contents. It is a cached/shared data structure. Your
1001 changes c/would be passed around in subsequent calls.
1005 sub GetMarcStructure {
1006 my ( $forlibrarian, $frameworkcode, $params ) = @_;
1007 $frameworkcode = "" unless $frameworkcode;
1009 $forlibrarian = $forlibrarian ? 1 : 0;
1010 my $unsafe = ($params && $params->{unsafe})? 1: 0;
1011 my $cache = Koha::Caches->get_instance();
1012 my $cache_key = "MarcStructure-$forlibrarian-$frameworkcode";
1013 my $cached = $cache->get_from_cache($cache_key, { unsafe => $unsafe });
1014 return $cached if $cached;
1016 my $dbh = C4::Context->dbh;
1017 my $sth = $dbh->prepare(
1018 "SELECT tagfield,liblibrarian,libopac,mandatory,repeatable
1019 FROM marc_tag_structure
1020 WHERE frameworkcode=?
1023 $sth->execute($frameworkcode);
1024 my ( $liblibrarian, $libopac, $tag, $res, $tab, $mandatory, $repeatable );
1026 while ( ( $tag, $liblibrarian, $libopac, $mandatory, $repeatable ) = $sth->fetchrow ) {
1027 $res->{$tag}->{lib} = ( $forlibrarian or !$libopac ) ? $liblibrarian : $libopac;
1028 $res->{$tag}->{tab} = "";
1029 $res->{$tag}->{mandatory} = $mandatory;
1030 $res->{$tag}->{repeatable} = $repeatable;
1033 $sth = $dbh->prepare(
1034 "SELECT tagfield,tagsubfield,liblibrarian,libopac,tab,mandatory,repeatable,authorised_value,authtypecode,value_builder,kohafield,seealso,hidden,isurl,link,defaultvalue,maxlength
1035 FROM marc_subfield_structure
1036 WHERE frameworkcode=?
1037 ORDER BY tagfield,tagsubfield
1041 $sth->execute($frameworkcode);
1044 my $authorised_value;
1056 ( $tag, $subfield, $liblibrarian, $libopac, $tab, $mandatory, $repeatable, $authorised_value,
1057 $authtypecode, $value_builder, $kohafield, $seealso, $hidden, $isurl, $link, $defaultvalue,
1062 $res->{$tag}->{$subfield}->{lib} = ( $forlibrarian or !$libopac ) ? $liblibrarian : $libopac;
1063 $res->{$tag}->{$subfield}->{tab} = $tab;
1064 $res->{$tag}->{$subfield}->{mandatory} = $mandatory;
1065 $res->{$tag}->{$subfield}->{repeatable} = $repeatable;
1066 $res->{$tag}->{$subfield}->{authorised_value} = $authorised_value;
1067 $res->{$tag}->{$subfield}->{authtypecode} = $authtypecode;
1068 $res->{$tag}->{$subfield}->{value_builder} = $value_builder;
1069 $res->{$tag}->{$subfield}->{kohafield} = $kohafield;
1070 $res->{$tag}->{$subfield}->{seealso} = $seealso;
1071 $res->{$tag}->{$subfield}->{hidden} = $hidden;
1072 $res->{$tag}->{$subfield}->{isurl} = $isurl;
1073 $res->{$tag}->{$subfield}->{'link'} = $link;
1074 $res->{$tag}->{$subfield}->{defaultvalue} = $defaultvalue;
1075 $res->{$tag}->{$subfield}->{maxlength} = $maxlength;
1078 $cache->set_in_cache($cache_key, $res);
1082 =head2 GetUsedMarcStructure
1084 The same function as GetMarcStructure except it just takes field
1085 in tab 0-9. (used field)
1087 my $results = GetUsedMarcStructure($frameworkcode);
1089 C<$results> is a ref to an array which each case containts a ref
1090 to a hash which each keys is the columns from marc_subfield_structure
1092 C<$frameworkcode> is the framework code.
1096 sub GetUsedMarcStructure {
1097 my $frameworkcode = shift || '';
1100 FROM marc_subfield_structure
1102 AND frameworkcode = ?
1103 ORDER BY tagfield, tagsubfield
1105 my $sth = C4::Context->dbh->prepare($query);
1106 $sth->execute($frameworkcode);
1107 return $sth->fetchall_arrayref( {} );
1110 =head2 GetMarcSubfieldStructure
1114 sub GetMarcSubfieldStructure {
1115 my ( $frameworkcode ) = @_;
1117 $frameworkcode //= '';
1119 my $cache = Koha::Caches->get_instance();
1120 my $cache_key = "MarcSubfieldStructure-$frameworkcode";
1121 my $cached = $cache->get_from_cache($cache_key);
1122 return $cached if $cached;
1124 my $dbh = C4::Context->dbh;
1125 my $subfield_structure = $dbh->selectall_hashref( q|
1127 FROM marc_subfield_structure
1128 WHERE frameworkcode = ?
1130 |, 'kohafield', {}, $frameworkcode );
1132 $cache->set_in_cache( $cache_key, $subfield_structure );
1133 return $subfield_structure;
1136 =head2 GetMarcFromKohaField
1138 ($MARCfield,$MARCsubfield)=GetMarcFromKohaField($kohafield,$frameworkcode);
1140 Returns the MARC fields & subfields mapped to the koha field
1141 for the given frameworkcode or default framework if $frameworkcode is missing
1145 sub GetMarcFromKohaField {
1146 my ( $kohafield, $frameworkcode ) = @_;
1147 return (0, undef) unless $kohafield;
1148 my $mss = GetMarcSubfieldStructure( $frameworkcode );
1149 return ( $mss->{$kohafield}{tagfield}, $mss->{$kohafield}{tagsubfield} );
1152 =head2 GetMarcSubfieldStructureFromKohaField
1154 my $subfield_structure = &GetMarcSubfieldStructureFromKohaField($kohafield, $frameworkcode);
1156 Returns a hashref where keys are marc_subfield_structure column names for the
1157 row where kohafield=$kohafield for the given framework code.
1159 $frameworkcode is optional. If not given, then the default framework is used.
1163 sub GetMarcSubfieldStructureFromKohaField {
1164 my ( $kohafield, $frameworkcode ) = @_;
1166 return unless $kohafield;
1168 my $mss = GetMarcSubfieldStructure( $frameworkcode );
1169 return exists $mss->{$kohafield}
1170 ? $mss->{$kohafield}
1174 =head2 GetMarcBiblio
1176 my $record = GetMarcBiblio($biblionumber, [$embeditems], [$opac]);
1178 Returns MARC::Record representing a biblio record, or C<undef> if the
1179 biblionumber doesn't exist.
1183 =item C<$biblionumber>
1187 =item C<$embeditems>
1189 set to true to include item information.
1193 set to true to make the result suited for OPAC view. This causes things like
1194 OpacHiddenItems to be applied.
1201 my $biblionumber = shift;
1202 my $embeditems = shift || 0;
1203 my $opac = shift || 0;
1205 if (not defined $biblionumber) {
1206 carp 'GetMarcBiblio called with undefined biblionumber';
1210 my $dbh = C4::Context->dbh;
1211 my $sth = $dbh->prepare("SELECT biblioitemnumber FROM biblioitems WHERE biblionumber=? ");
1212 $sth->execute($biblionumber);
1213 my $row = $sth->fetchrow_hashref;
1214 my $biblioitemnumber = $row->{'biblioitemnumber'};
1215 my $marcxml = GetXmlBiblio( $biblionumber );
1216 $marcxml = StripNonXmlChars( $marcxml );
1217 my $frameworkcode = GetFrameworkCode($biblionumber);
1218 MARC::File::XML->default_record_format( C4::Context->preference('marcflavour') );
1219 my $record = MARC::Record->new();
1223 MARC::Record::new_from_xml( $marcxml, "utf8",
1224 C4::Context->preference('marcflavour') );
1226 if ($@) { warn " problem with :$biblionumber : $@ \n$marcxml"; }
1227 return unless $record;
1229 C4::Biblio::_koha_marc_update_bib_ids( $record, $frameworkcode, $biblionumber,
1230 $biblioitemnumber );
1231 C4::Biblio::EmbedItemsInMarcBiblio( $record, $biblionumber, undef, $opac )
1243 my $marcxml = GetXmlBiblio($biblionumber);
1245 Returns biblio_metadata.metadata/marcxml of the biblionumber passed in parameter.
1246 The XML should only contain biblio information (item information is no longer stored in marcxml field)
1251 my ($biblionumber) = @_;
1252 my $dbh = C4::Context->dbh;
1253 return unless $biblionumber;
1254 my ($marcxml) = $dbh->selectrow_array(
1257 FROM biblio_metadata
1258 WHERE biblionumber=?
1259 AND format='marcxml'
1261 |, undef, $biblionumber, C4::Context->preference('marcflavour')
1266 =head2 GetCOinSBiblio
1268 my $coins = GetCOinSBiblio($record);
1270 Returns the COinS (a span) which can be included in a biblio record
1274 sub GetCOinSBiblio {
1277 # get the coin format
1279 carp 'GetCOinSBiblio called with undefined record';
1282 my $pos7 = substr $record->leader(), 7, 1;
1283 my $pos6 = substr $record->leader(), 6, 1;
1286 my ( $aulast, $aufirst ) = ( '', '' );
1295 my $titletype = 'b';
1297 # For the purposes of generating COinS metadata, LDR/06-07 can be
1298 # considered the same for UNIMARC and MARC21
1303 'b' => 'manuscript',
1305 'd' => 'manuscript',
1309 'i' => 'audioRecording',
1310 'j' => 'audioRecording',
1313 'm' => 'computerProgram',
1318 'a' => 'journalArticle',
1322 $genre = $fmts6->{$pos6} ? $fmts6->{$pos6} : 'book';
1324 if ( $genre eq 'book' ) {
1325 $genre = $fmts7->{$pos7} if $fmts7->{$pos7};
1328 ##### We must transform mtx to a valable mtx and document type ####
1329 if ( $genre eq 'book' ) {
1331 } elsif ( $genre eq 'journal' ) {
1334 } elsif ( $genre eq 'journalArticle' ) {
1342 $genre = ( $mtx eq 'dc' ) ? "&rft.type=$genre" : "&rft.genre=$genre";
1344 if ( C4::Context->preference("marcflavour") eq "UNIMARC" ) {
1347 $aulast = $record->subfield( '700', 'a' ) || '';
1348 $aufirst = $record->subfield( '700', 'b' ) || '';
1349 $oauthors = "&rft.au=$aufirst $aulast";
1352 if ( $record->field('200') ) {
1353 for my $au ( $record->field('200')->subfield('g') ) {
1354 $oauthors .= "&rft.au=$au";
1359 ? "&rft.title=" . $record->subfield( '200', 'a' )
1360 : "&rft.title=" . $record->subfield( '200', 'a' ) . "&rft.btitle=" . $record->subfield( '200', 'a' );
1361 $pubyear = $record->subfield( '210', 'd' ) || '';
1362 $publisher = $record->subfield( '210', 'c' ) || '';
1363 $isbn = $record->subfield( '010', 'a' ) || '';
1364 $issn = $record->subfield( '011', 'a' ) || '';
1367 # MARC21 need some improve
1370 if ( $record->field('100') ) {
1371 $oauthors .= "&rft.au=" . $record->subfield( '100', 'a' );
1375 if ( $record->field('700') ) {
1376 for my $au ( $record->field('700')->subfield('a') ) {
1377 $oauthors .= "&rft.au=$au";
1380 $title = "&rft." . $titletype . "title=" . $record->subfield( '245', 'a' );
1381 $subtitle = $record->subfield( '245', 'b' ) || '';
1382 $title .= $subtitle;
1383 if ($titletype eq 'a') {
1384 $pubyear = $record->field('008') || '';
1385 $pubyear = substr($pubyear->data(), 7, 4) if $pubyear;
1386 $isbn = $record->subfield( '773', 'z' ) || '';
1387 $issn = $record->subfield( '773', 'x' ) || '';
1388 if ($mtx eq 'journal') {
1389 $title .= "&rft.title=" . (($record->subfield( '773', 't' ) || $record->subfield( '773', 'a')));
1391 $title .= "&rft.btitle=" . (($record->subfield( '773', 't' ) || $record->subfield( '773', 'a')) || '');
1393 foreach my $rel ($record->subfield( '773', 'g' )) {
1400 $pubyear = $record->subfield( '260', 'c' ) || '';
1401 $publisher = $record->subfield( '260', 'b' ) || '';
1402 $isbn = $record->subfield( '020', 'a' ) || '';
1403 $issn = $record->subfield( '022', 'a' ) || '';
1408 "ctx_ver=Z39.88-2004&rft_val_fmt=info%3Aofi%2Ffmt%3Akev%3Amtx%3A$mtx$genre$title&rft.isbn=$isbn&rft.issn=$issn&rft.aulast=$aulast&rft.aufirst=$aufirst$oauthors&rft.pub=$publisher&rft.date=$pubyear&rft.pages=$pages";
1409 $coins_value =~ s/(\ |&[^a])/\+/g;
1410 $coins_value =~ s/\"/\"\;/g;
1412 #<!-- TMPL_VAR NAME="ocoins_format" -->&rft.au=<!-- TMPL_VAR NAME="author" -->&rft.btitle=<!-- TMPL_VAR NAME="title" -->&rft.date=<!-- TMPL_VAR NAME="publicationyear" -->&rft.pages=<!-- TMPL_VAR NAME="pages" -->&rft.isbn=<!-- TMPL_VAR NAME=amazonisbn -->&rft.aucorp=&rft.place=<!-- TMPL_VAR NAME="place" -->&rft.pub=<!-- TMPL_VAR NAME="publishercode" -->&rft.edition=<!-- TMPL_VAR NAME="edition" -->&rft.series=<!-- TMPL_VAR NAME="series" -->&rft.genre="
1414 return $coins_value;
1420 return the prices in accordance with the Marc format.
1422 returns 0 if no price found
1423 returns undef if called without a marc record or with
1424 an unrecognized marc format
1429 my ( $record, $marcflavour ) = @_;
1431 carp 'GetMarcPrice called on undefined record';
1438 if ( $marcflavour eq "MARC21" || $marcflavour eq "NORMARC" ) {
1439 @listtags = ('345', '020');
1441 } elsif ( $marcflavour eq "UNIMARC" ) {
1442 @listtags = ('345', '010');
1448 for my $field ( $record->field(@listtags) ) {
1449 for my $subfield_value ($field->subfield($subfield)){
1451 $subfield_value = MungeMarcPrice( $subfield_value );
1452 return $subfield_value if ($subfield_value);
1455 return 0; # no price found
1458 =head2 MungeMarcPrice
1460 Return the best guess at what the actual price is from a price field.
1463 sub MungeMarcPrice {
1465 return unless ( $price =~ m/\d/ ); ## No digits means no price.
1466 # Look for the currency symbol and the normalized code of the active currency, if it's there,
1467 my $active_currency = Koha::Acquisition::Currencies->get_active;
1468 my $symbol = $active_currency->symbol;
1469 my $isocode = $active_currency->isocode;
1470 $isocode = $active_currency->currency unless defined $isocode;
1473 my @matches =($price=~ /
1475 ( # start of capturing parenthesis
1477 (?:[\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'
1478 |(?:\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'
1480 \s?\p{Sc}?\s? # followed or not by a whitespace. \p{Sc}?\s? are for cases like '25$ USD'
1482 (?:[\p{Sc}\p{L}\/.]){1,4} # followed by same block as symbol block
1483 |(?:\d+[\p{P}\s]?){1,4} # or by same block as digits block
1485 \s?\p{L}{0,4}\s? # followed or not by a whitespace. \p{L}{0,4}\s? are for cases like '$9.50 USD'
1486 ) # end of capturing parenthesis
1487 (?:\p{P}|\z) # followed by a punctuation sign or by the end of the string
1491 foreach ( @matches ) {
1492 $localprice = $_ and last if index($_, $isocode)>=0;
1494 if ( !$localprice ) {
1495 foreach ( @matches ) {
1496 $localprice = $_ and last if $_=~ /(^|[^\p{Sc}\p{L}\/])\Q$symbol\E([^\p{Sc}\p{L}\/]+\z|\z)/;
1501 if ( $localprice ) {
1502 $price = $localprice;
1504 ## Grab the first number in the string ( can use commas or periods for thousands separator and/or decimal separator )
1505 ( $price ) = $price =~ m/([\d\,\.]+[[\,\.]\d\d]?)/;
1507 # eliminate symbol/isocode, space and any final dot from the string
1508 $price =~ s/[\p{Sc}\p{L}\/ ]|\.$//g;
1509 # remove comma,dot when used as separators from hundreds
1510 $price =~s/[\,\.](\d{3})/$1/g;
1511 # convert comma to dot to ensure correct display of decimals if existing
1517 =head2 GetMarcQuantity
1519 return the quantity of a book. Used in acquisition only, when importing a file an iso2709 from a bookseller
1520 Warning : this is not really in the marc standard. In Unimarc, Electre (the most widely used bookseller) use the 969$a
1522 returns 0 if no quantity found
1523 returns undef if called without a marc record or with
1524 an unrecognized marc format
1528 sub GetMarcQuantity {
1529 my ( $record, $marcflavour ) = @_;
1531 carp 'GetMarcQuantity called on undefined record';
1538 if ( $marcflavour eq "MARC21" ) {
1540 } elsif ( $marcflavour eq "UNIMARC" ) {
1541 @listtags = ('969');
1547 for my $field ( $record->field(@listtags) ) {
1548 for my $subfield_value ($field->subfield($subfield)){
1550 if ($subfield_value) {
1551 # in France, the cents separator is the , but sometimes, ppl use a .
1552 # in this case, the price will be x100 when unformatted ! Replace the . by a , to get a proper price calculation
1553 $subfield_value =~ s/\./,/ if C4::Context->preference("CurrencyFormat") eq "FR";
1554 return $subfield_value;
1558 return 0; # no price found
1562 =head2 GetAuthorisedValueDesc
1564 my $subfieldvalue =get_authorised_value_desc(
1565 $tag, $subf[$i][0],$subf[$i][1], '', $taglib, $category, $opac);
1567 Retrieve the complete description for a given authorised value.
1569 Now takes $category and $value pair too.
1571 my $auth_value_desc =GetAuthorisedValueDesc(
1572 '','', 'DVD' ,'','','CCODE');
1574 If the optional $opac parameter is set to a true value, displays OPAC
1575 descriptions rather than normal ones when they exist.
1579 sub GetAuthorisedValueDesc {
1580 my ( $tag, $subfield, $value, $framework, $tagslib, $category, $opac ) = @_;
1584 return $value unless defined $tagslib->{$tag}->{$subfield}->{'authorised_value'};
1587 if ( $tagslib->{$tag}->{$subfield}->{'authorised_value'} eq "branches" ) {
1588 return Koha::Libraries->find($value)->branchname;
1592 if ( $tagslib->{$tag}->{$subfield}->{'authorised_value'} eq "itemtypes" ) {
1593 my $itemtype = Koha::ItemTypes->find( $value );
1594 return $itemtype ? $itemtype->translated_description : q||;
1597 #---- "true" authorized value
1598 $category = $tagslib->{$tag}->{$subfield}->{'authorised_value'};
1601 my $dbh = C4::Context->dbh;
1602 if ( $category ne "" ) {
1603 my $sth = $dbh->prepare( "SELECT lib, lib_opac FROM authorised_values WHERE category = ? AND authorised_value = ?" );
1604 $sth->execute( $category, $value );
1605 my $data = $sth->fetchrow_hashref;
1606 return ( $opac && $data->{'lib_opac'} ) ? $data->{'lib_opac'} : $data->{'lib'};
1608 return $value; # if nothing is found return the original value
1612 =head2 GetMarcControlnumber
1614 $marccontrolnumber = GetMarcControlnumber($record,$marcflavour);
1616 Get the control number / record Identifier from the MARC record and return it.
1620 sub GetMarcControlnumber {
1621 my ( $record, $marcflavour ) = @_;
1623 carp 'GetMarcControlnumber called on undefined record';
1626 my $controlnumber = "";
1627 # Control number or Record identifier are the same field in MARC21, UNIMARC and NORMARC
1628 # Keep $marcflavour for possible later use
1629 if ($marcflavour eq "MARC21" || $marcflavour eq "UNIMARC" || $marcflavour eq "NORMARC") {
1630 my $controlnumberField = $record->field('001');
1631 if ($controlnumberField) {
1632 $controlnumber = $controlnumberField->data();
1635 return $controlnumber;
1640 $marcisbnsarray = GetMarcISBN( $record, $marcflavour );
1642 Get all ISBNs from the MARC record and returns them in an array.
1643 ISBNs stored in different fields depending on MARC flavour
1648 my ( $record, $marcflavour ) = @_;
1650 carp 'GetMarcISBN called on undefined record';
1654 if ( $marcflavour eq "UNIMARC" ) {
1656 } else { # assume marc21 if not unimarc
1661 foreach my $field ( $record->field($scope) ) {
1662 my $isbn = $field->subfield( 'a' );
1663 if ( $isbn ne "" ) {
1664 push @marcisbns, $isbn;
1674 $marcissnsarray = GetMarcISSN( $record, $marcflavour );
1676 Get all valid ISSNs from the MARC record and returns them in an array.
1677 ISSNs are stored in different fields depending on MARC flavour
1682 my ( $record, $marcflavour ) = @_;
1684 carp 'GetMarcISSN called on undefined record';
1688 if ( $marcflavour eq "UNIMARC" ) {
1691 else { # assume MARC21 or NORMARC
1695 foreach my $field ( $record->field($scope) ) {
1696 push @marcissns, $field->subfield( 'a' )
1697 if ( $field->subfield( 'a' ) ne "" );
1704 $marcnotesarray = GetMarcNotes( $record, $marcflavour );
1706 Get all notes from the MARC record and returns them in an array.
1707 The notes are stored in different fields depending on MARC flavour.
1708 MARC21 field 555 gets special attention for the $u subfields.
1713 my ( $record, $marcflavour ) = @_;
1715 carp 'GetMarcNotes called on undefined record';
1719 my $scope = $marcflavour eq "UNIMARC"? '3..': '5..';
1721 my %blacklist = map { $_ => 1 }
1722 split( /,/, C4::Context->preference('NotesBlacklist'));
1723 foreach my $field ( $record->field($scope) ) {
1724 my $tag = $field->tag();
1725 next if $blacklist{ $tag };
1726 if( $marcflavour ne 'UNIMARC' && $tag =~ /555/ ) {
1727 # Field 555$u contains URLs
1728 # We first push the regular subfields and all $u's separately
1729 # Leave further actions to the template
1730 push @marcnotes, { marcnote => $field->as_string('abcd') };
1731 foreach my $sub ( $field->subfield('u') ) {
1732 push @marcnotes, { marcnote => $sub };
1735 push @marcnotes, { marcnote => $field->as_string() };
1741 =head2 GetMarcSubjects
1743 $marcsubjcts = GetMarcSubjects($record,$marcflavour);
1745 Get all subjects from the MARC record and returns them in an array.
1746 The subjects are stored in different fields depending on MARC flavour
1750 sub GetMarcSubjects {
1751 my ( $record, $marcflavour ) = @_;
1753 carp 'GetMarcSubjects called on undefined record';
1756 my ( $mintag, $maxtag, $fields_filter );
1757 if ( $marcflavour eq "UNIMARC" ) {
1760 $fields_filter = '6..';
1761 } else { # marc21/normarc
1764 $fields_filter = '6..';
1769 my $subject_limit = C4::Context->preference("TraceCompleteSubfields") ? 'su,complete-subfield' : 'su';
1770 my $AuthoritySeparator = C4::Context->preference('AuthoritySeparator');
1772 foreach my $field ( $record->field($fields_filter) ) {
1773 next unless ($field->tag() >= $mintag && $field->tag() <= $maxtag);
1775 my @subfields = $field->subfields();
1778 # if there is an authority link, build the links with an= subfield9
1779 my $subfield9 = $field->subfield('9');
1782 my $linkvalue = $subfield9;
1783 $linkvalue =~ s/(\(|\))//g;
1784 @link_loop = ( { limit => 'an', 'link' => $linkvalue } );
1785 $authoritylink = $linkvalue
1789 for my $subject_subfield (@subfields) {
1790 next if ( $subject_subfield->[0] eq '9' );
1792 # don't load unimarc subfields 3,4,5
1793 next if ( ( $marcflavour eq "UNIMARC" ) and ( $subject_subfield->[0] =~ /2|3|4|5/ ) );
1794 # don't load MARC21 subfields 2 (FIXME: any more subfields??)
1795 next if ( ( $marcflavour eq "MARC21" ) and ( $subject_subfield->[0] =~ /2/ ) );
1797 my $code = $subject_subfield->[0];
1798 my $value = $subject_subfield->[1];
1799 my $linkvalue = $value;
1800 $linkvalue =~ s/(\(|\))//g;
1801 # if no authority link, build a search query
1802 unless ($subfield9) {
1804 limit => $subject_limit,
1805 'link' => $linkvalue,
1806 operator => (scalar @link_loop) ? ' and ' : undef
1809 my @this_link_loop = @link_loop;
1811 unless ( $code eq '0' ) {
1812 push @subfields_loop, {
1815 link_loop => \@this_link_loop,
1816 separator => (scalar @subfields_loop) ? $AuthoritySeparator : ''
1821 push @marcsubjects, {
1822 MARCSUBJECT_SUBFIELDS_LOOP => \@subfields_loop,
1823 authoritylink => $authoritylink,
1824 } if $authoritylink || @subfields_loop;
1827 return \@marcsubjects;
1828 } #end getMARCsubjects
1830 =head2 GetMarcAuthors
1832 authors = GetMarcAuthors($record,$marcflavour);
1834 Get all authors from the MARC record and returns them in an array.
1835 The authors are stored in different fields depending on MARC flavour
1839 sub GetMarcAuthors {
1840 my ( $record, $marcflavour ) = @_;
1842 carp 'GetMarcAuthors called on undefined record';
1845 my ( $mintag, $maxtag, $fields_filter );
1847 # tagslib useful only for UNIMARC author responsibilities
1849 if ( $marcflavour eq "UNIMARC" ) {
1850 # FIXME : we don't have the framework available, we take the default framework. May be buggy on some setups, will be usually correct.
1851 $tagslib = GetMarcStructure( 1, '', { unsafe => 1 });
1854 $fields_filter = '7..';
1855 } else { # marc21/normarc
1858 $fields_filter = '7..';
1862 my $AuthoritySeparator = C4::Context->preference('AuthoritySeparator');
1864 foreach my $field ( $record->field($fields_filter) ) {
1865 next unless $field->tag() >= $mintag && $field->tag() <= $maxtag;
1868 my @subfields = $field->subfields();
1871 # if there is an authority link, build the link with Koha-Auth-Number: subfield9
1872 my $subfield9 = $field->subfield('9');
1874 my $linkvalue = $subfield9;
1875 $linkvalue =~ s/(\(|\))//g;
1876 @link_loop = ( { 'limit' => 'an', 'link' => $linkvalue } );
1881 for my $authors_subfield (@subfields) {
1882 next if ( $authors_subfield->[0] eq '9' );
1884 # unimarc3 contains the $3 of the author for UNIMARC.
1885 # For french academic libraries, it's the "ppn", and it's required for idref webservice
1886 $unimarc3 = $authors_subfield->[1] if $marcflavour eq 'UNIMARC' and $authors_subfield->[0] =~ /3/;
1888 # don't load unimarc subfields 3, 5
1889 next if ( $marcflavour eq 'UNIMARC' and ( $authors_subfield->[0] =~ /3|5/ ) );
1891 my $code = $authors_subfield->[0];
1892 my $value = $authors_subfield->[1];
1893 my $linkvalue = $value;
1894 $linkvalue =~ s/(\(|\))//g;
1895 # UNIMARC author responsibility
1896 if ( $marcflavour eq 'UNIMARC' and $code eq '4' ) {
1897 $value = GetAuthorisedValueDesc( $field->tag(), $code, $value, '', $tagslib );
1898 $linkvalue = "($value)";
1900 # if no authority link, build a search query
1901 unless ($subfield9) {
1904 'link' => $linkvalue,
1905 operator => (scalar @link_loop) ? ' and ' : undef
1908 my @this_link_loop = @link_loop;
1910 unless ( $code eq '0') {
1911 push @subfields_loop, {
1912 tag => $field->tag(),
1915 link_loop => \@this_link_loop,
1916 separator => (scalar @subfields_loop) ? $AuthoritySeparator : ''
1920 push @marcauthors, {
1921 MARCAUTHOR_SUBFIELDS_LOOP => \@subfields_loop,
1922 authoritylink => $subfield9,
1923 unimarc3 => $unimarc3
1926 return \@marcauthors;
1931 $marcurls = GetMarcUrls($record,$marcflavour);
1933 Returns arrayref of URLs from MARC data, suitable to pass to tmpl loop.
1934 Assumes web resources (not uncommon in MARC21 to omit resource type ind)
1939 my ( $record, $marcflavour ) = @_;
1941 carp 'GetMarcUrls called on undefined record';
1946 for my $field ( $record->field('856') ) {
1948 for my $note ( $field->subfield('z') ) {
1949 push @notes, { note => $note };
1951 my @urls = $field->subfield('u');
1952 foreach my $url (@urls) {
1953 $url =~ s/^\s+|\s+$//g; # trim
1955 if ( $marcflavour eq 'MARC21' ) {
1956 my $s3 = $field->subfield('3');
1957 my $link = $field->subfield('y');
1958 unless ( $url =~ /^\w+:/ ) {
1959 if ( $field->indicator(1) eq '7' ) {
1960 $url = $field->subfield('2') . "://" . $url;
1961 } elsif ( $field->indicator(1) eq '1' ) {
1962 $url = 'ftp://' . $url;
1965 # properly, this should be if ind1=4,
1966 # however we will assume http protocol since we're building a link.
1967 $url = 'http://' . $url;
1971 # TODO handle ind 2 (relationship)
1976 $marcurl->{'linktext'} = $link || $s3 || C4::Context->preference('URLLinkText') || $url;
1977 $marcurl->{'part'} = $s3 if ($link);
1978 $marcurl->{'toc'} = 1 if ( defined($s3) && $s3 =~ /^[Tt]able/ );
1980 $marcurl->{'linktext'} = $field->subfield('2') || C4::Context->preference('URLLinkText') || $url;
1981 $marcurl->{'MARCURL'} = $url;
1983 push @marcurls, $marcurl;
1989 =head2 GetMarcSeries
1991 $marcseriesarray = GetMarcSeries($record,$marcflavour);
1993 Get all series from the MARC record and returns them in an array.
1994 The series are stored in different fields depending on MARC flavour
1999 my ( $record, $marcflavour ) = @_;
2001 carp 'GetMarcSeries called on undefined record';
2005 my ( $mintag, $maxtag, $fields_filter );
2006 if ( $marcflavour eq "UNIMARC" ) {
2009 $fields_filter = '2..';
2010 } else { # marc21/normarc
2013 $fields_filter = '4..';
2017 my $AuthoritySeparator = C4::Context->preference('AuthoritySeparator');
2019 foreach my $field ( $record->field($fields_filter) ) {
2020 next unless $field->tag() >= $mintag && $field->tag() <= $maxtag;
2022 my @subfields = $field->subfields();
2025 for my $series_subfield (@subfields) {
2027 # ignore $9, used for authority link
2028 next if ( $series_subfield->[0] eq '9' );
2031 my $code = $series_subfield->[0];
2032 my $value = $series_subfield->[1];
2033 my $linkvalue = $value;
2034 $linkvalue =~ s/(\(|\))//g;
2036 # see if this is an instance of a volume
2037 if ( $code eq 'v' ) {
2042 'link' => $linkvalue,
2043 operator => (scalar @link_loop) ? ' and ' : undef
2046 if ($volume_number) {
2047 push @subfields_loop, { volumenum => $value };
2049 push @subfields_loop, {
2052 link_loop => \@link_loop,
2053 separator => (scalar @subfields_loop) ? $AuthoritySeparator : '',
2054 volumenum => $volume_number,
2058 push @marcseries, { MARCSERIES_SUBFIELDS_LOOP => \@subfields_loop };
2061 return \@marcseries;
2062 } #end getMARCseriess
2066 $marchostsarray = GetMarcHosts($record,$marcflavour);
2068 Get all host records (773s MARC21, 461 UNIMARC) from the MARC record and returns them in an array.
2073 my ( $record, $marcflavour ) = @_;
2075 carp 'GetMarcHosts called on undefined record';
2079 my ( $tag,$title_subf,$bibnumber_subf,$itemnumber_subf);
2080 $marcflavour ||="MARC21";
2081 if ( $marcflavour eq "MARC21" || $marcflavour eq "NORMARC" ) {
2084 $bibnumber_subf ="0";
2085 $itemnumber_subf='9';
2087 elsif ($marcflavour eq "UNIMARC") {
2090 $bibnumber_subf ="0";
2091 $itemnumber_subf='9';
2096 foreach my $field ( $record->field($tag)) {
2100 my $hostbiblionumber = $field->subfield("$bibnumber_subf");
2101 my $hosttitle = $field->subfield($title_subf);
2102 my $hostitemnumber=$field->subfield($itemnumber_subf);
2103 push @fields_loop, { hostbiblionumber => $hostbiblionumber, hosttitle => $hosttitle, hostitemnumber => $hostitemnumber};
2104 push @marchosts, { MARCHOSTS_FIELDS_LOOP => \@fields_loop };
2107 my $marchostsarray = \@marchosts;
2108 return $marchostsarray;
2111 =head2 UpsertMarcSubfield
2113 my $record = C4::Biblio::UpsertMarcSubfield($MARC::Record, $fieldTag, $subfieldCode, $subfieldContent);
2117 sub UpsertMarcSubfield {
2118 my ($record, $tag, $code, $content) = @_;
2119 my $f = $record->field($tag);
2122 $f->update( $code => $content );
2125 my $f = MARC::Field->new( $tag, '', '', $code => $content);
2126 $record->insert_fields_ordered( $f );
2130 =head2 UpsertMarcControlField
2132 my $record = C4::Biblio::UpsertMarcControlField($MARC::Record, $fieldTag, $content);
2136 sub UpsertMarcControlField {
2137 my ($record, $tag, $content) = @_;
2138 die "UpsertMarcControlField() \$tag '$tag' is not a control field\n" unless 0+$tag < 10;
2139 my $f = $record->field($tag);
2142 $f->update( $content );
2145 my $f = MARC::Field->new($tag, $content);
2146 $record->insert_fields_ordered( $f );
2150 =head2 GetFrameworkCode
2152 $frameworkcode = GetFrameworkCode( $biblionumber )
2156 sub GetFrameworkCode {
2157 my ($biblionumber) = @_;
2158 my $dbh = C4::Context->dbh;
2159 my $sth = $dbh->prepare("SELECT frameworkcode FROM biblio WHERE biblionumber=?");
2160 $sth->execute($biblionumber);
2161 my ($frameworkcode) = $sth->fetchrow;
2162 return $frameworkcode;
2165 =head2 TransformKohaToMarc
2167 $record = TransformKohaToMarc( $hash )
2169 This function builds partial MARC::Record from a hash
2170 Hash entries can be from biblio or biblioitems.
2172 This function is called in acquisition module, to create a basic catalogue
2173 entry from user entry
2178 sub TransformKohaToMarc {
2180 my $record = MARC::Record->new();
2181 SetMarcUnicodeFlag( $record, C4::Context->preference("marcflavour") );
2182 # FIXME Do not we want to get the marc subfield structure for the biblio framework?
2183 my $mss = GetMarcSubfieldStructure();
2185 while ( my ($kohafield, $value) = each %$hash ) {
2186 next unless exists $mss->{$kohafield};
2187 next unless $mss->{$kohafield};
2188 my $tagfield = $mss->{$kohafield}{tagfield} . '';
2189 my $tagsubfield = $mss->{$kohafield}{tagsubfield};
2190 foreach my $value ( split(/\s?\|\s?/, $value, -1) ) {
2191 next if $value eq '';
2192 $tag_hr->{$tagfield} //= [];
2193 push @{$tag_hr->{$tagfield}}, [($tagsubfield, $value)];
2196 foreach my $tag (sort keys %$tag_hr) {
2197 my @sfl = @{$tag_hr->{$tag}};
2198 @sfl = sort { $a->[0] cmp $b->[0]; } @sfl;
2199 @sfl = map { @{$_}; } @sfl;
2200 $record->insert_fields_ordered(
2201 MARC::Field->new($tag, " ", " ", @sfl)
2207 =head2 PrepHostMarcField
2209 $hostfield = PrepHostMarcField ( $hostbiblionumber,$hostitemnumber,$marcflavour )
2211 This function returns a host field populated with data from the host record, the field can then be added to an analytical record
2215 sub PrepHostMarcField {
2216 my ($hostbiblionumber,$hostitemnumber, $marcflavour) = @_;
2217 $marcflavour ||="MARC21";
2220 my $hostrecord = GetMarcBiblio($hostbiblionumber);
2221 my $item = C4::Items::GetItem($hostitemnumber);
2224 if ( $marcflavour eq "MARC21" || $marcflavour eq "NORMARC" ) {
2228 if ($hostrecord->subfield('100','a')){
2229 $mainentry = $hostrecord->subfield('100','a');
2230 } elsif ($hostrecord->subfield('110','a')){
2231 $mainentry = $hostrecord->subfield('110','a');
2233 $mainentry = $hostrecord->subfield('111','a');
2236 # qualification info
2238 if (my $field260 = $hostrecord->field('260')){
2239 $qualinfo = $field260->as_string( 'abc' );
2244 my $ed = $hostrecord->subfield('250','a');
2245 my $barcode = $item->{'barcode'};
2246 my $title = $hostrecord->subfield('245','a');
2248 # record control number, 001 with 003 and prefix
2250 if ($hostrecord->field('001')){
2251 $recctrlno = $hostrecord->field('001')->data();
2252 if ($hostrecord->field('003')){
2253 $recctrlno = '('.$hostrecord->field('003')->data().')'.$recctrlno;
2258 my $issn = $hostrecord->subfield('022','a');
2259 my $isbn = $hostrecord->subfield('020','a');
2262 $hostmarcfield = MARC::Field->new(
2264 '0' => $hostbiblionumber,
2265 '9' => $hostitemnumber,
2275 } elsif ($marcflavour eq "UNIMARC") {
2276 $hostmarcfield = MARC::Field->new(
2278 '0' => $hostbiblionumber,
2279 't' => $hostrecord->subfield('200','a'),
2280 '9' => $hostitemnumber
2284 return $hostmarcfield;
2287 =head2 TransformHtmlToXml
2289 $xml = TransformHtmlToXml( $tags, $subfields, $values, $indicator,
2290 $ind_tag, $auth_type )
2292 $auth_type contains :
2296 =item - nothing : rebuild a biblio. In UNIMARC the encoding is in 100$a pos 26/27
2298 =item - UNIMARCAUTH : rebuild an authority. In UNIMARC, the encoding is in 100$a pos 13/14
2300 =item - ITEM : rebuild an item : in UNIMARC, 100$a, it's in the biblio ! (otherwise, we would get 2 100 fields !)
2306 sub TransformHtmlToXml {
2307 my ( $tags, $subfields, $values, $indicator, $ind_tag, $auth_type ) = @_;
2308 # NOTE: The parameter $ind_tag is NOT USED -- BZ 11247
2310 my $xml = MARC::File::XML::header('UTF-8');
2311 $xml .= "<record>\n";
2312 $auth_type = C4::Context->preference('marcflavour') unless $auth_type;
2313 MARC::File::XML->default_record_format($auth_type);
2315 # in UNIMARC, field 100 contains the encoding
2316 # check that there is one, otherwise the
2317 # MARC::Record->new_from_xml will fail (and Koha will die)
2318 my $unimarc_and_100_exist = 0;
2319 $unimarc_and_100_exist = 1 if $auth_type eq 'ITEM'; # if we rebuild an item, no need of a 100 field
2324 for ( my $i = 0 ; $i < @$tags ; $i++ ) {
2326 if ( C4::Context->preference('marcflavour') eq 'UNIMARC' and @$tags[$i] eq "100" and @$subfields[$i] eq "a" ) {
2328 # if we have a 100 field and it's values are not correct, skip them.
2329 # if we don't have any valid 100 field, we will create a default one at the end
2330 my $enc = substr( @$values[$i], 26, 2 );
2331 if ( $enc eq '01' or $enc eq '50' or $enc eq '03' ) {
2332 $unimarc_and_100_exist = 1;
2337 @$values[$i] =~ s/&/&/g;
2338 @$values[$i] =~ s/</</g;
2339 @$values[$i] =~ s/>/>/g;
2340 @$values[$i] =~ s/"/"/g;
2341 @$values[$i] =~ s/'/'/g;
2343 if ( ( @$tags[$i] ne $prevtag ) ) {
2344 $j++ unless ( @$tags[$i] eq "" );
2345 my $indicator1 = eval { substr( @$indicator[$j], 0, 1 ) };
2346 my $indicator2 = eval { substr( @$indicator[$j], 1, 1 ) };
2347 my $ind1 = _default_ind_to_space($indicator1);
2349 if ( @$indicator[$j] ) {
2350 $ind2 = _default_ind_to_space($indicator2);
2352 warn "Indicator in @$tags[$i] is empty";
2356 $xml .= "</datafield>\n";
2357 if ( ( @$tags[$i] && @$tags[$i] > 10 )
2358 && ( @$values[$i] ne "" ) ) {
2359 $xml .= "<datafield tag=\"@$tags[$i]\" ind1=\"$ind1\" ind2=\"$ind2\">\n";
2360 $xml .= "<subfield code=\"@$subfields[$i]\">@$values[$i]</subfield>\n";
2366 if ( @$values[$i] ne "" ) {
2369 if ( @$tags[$i] eq "000" ) {
2370 $xml .= "<leader>@$values[$i]</leader>\n";
2373 # rest of the fixed fields
2374 } elsif ( @$tags[$i] < 10 ) {
2375 $xml .= "<controlfield tag=\"@$tags[$i]\">@$values[$i]</controlfield>\n";
2378 $xml .= "<datafield tag=\"@$tags[$i]\" ind1=\"$ind1\" ind2=\"$ind2\">\n";
2379 $xml .= "<subfield code=\"@$subfields[$i]\">@$values[$i]</subfield>\n";
2384 } else { # @$tags[$i] eq $prevtag
2385 my $indicator1 = eval { substr( @$indicator[$j], 0, 1 ) };
2386 my $indicator2 = eval { substr( @$indicator[$j], 1, 1 ) };
2387 my $ind1 = _default_ind_to_space($indicator1);
2389 if ( @$indicator[$j] ) {
2390 $ind2 = _default_ind_to_space($indicator2);
2392 warn "Indicator in @$tags[$i] is empty";
2395 if ( @$values[$i] eq "" ) {
2398 $xml .= "<datafield tag=\"@$tags[$i]\" ind1=\"$ind1\" ind2=\"$ind2\">\n";
2401 $xml .= "<subfield code=\"@$subfields[$i]\">@$values[$i]</subfield>\n";
2404 $prevtag = @$tags[$i];
2406 $xml .= "</datafield>\n" if $xml =~ m/<datafield/;
2407 if ( C4::Context->preference('marcflavour') eq 'UNIMARC' and !$unimarc_and_100_exist ) {
2409 # warn "SETTING 100 for $auth_type";
2410 my $string = strftime( "%Y%m%d", localtime(time) );
2412 # set 50 to position 26 is biblios, 13 if authorities
2414 $pos = 13 if $auth_type eq 'UNIMARCAUTH';
2415 $string = sprintf( "%-*s", 35, $string );
2416 substr( $string, $pos, 6, "50" );
2417 $xml .= "<datafield tag=\"100\" ind1=\"\" ind2=\"\">\n";
2418 $xml .= "<subfield code=\"a\">$string</subfield>\n";
2419 $xml .= "</datafield>\n";
2421 $xml .= "</record>\n";
2422 $xml .= MARC::File::XML::footer();
2426 =head2 _default_ind_to_space
2428 Passed what should be an indicator returns a space
2429 if its undefined or zero length
2433 sub _default_ind_to_space {
2435 if ( !defined $s || $s eq q{} ) {
2441 =head2 TransformHtmlToMarc
2443 L<$record> = TransformHtmlToMarc(L<$cgi>)
2444 L<$cgi> is the CGI object which containts the values for subfields
2446 'tag_010_indicator1_531951' ,
2447 'tag_010_indicator2_531951' ,
2448 'tag_010_code_a_531951_145735' ,
2449 'tag_010_subfield_a_531951_145735' ,
2450 'tag_200_indicator1_873510' ,
2451 'tag_200_indicator2_873510' ,
2452 'tag_200_code_a_873510_673465' ,
2453 'tag_200_subfield_a_873510_673465' ,
2454 'tag_200_code_b_873510_704318' ,
2455 'tag_200_subfield_b_873510_704318' ,
2456 'tag_200_code_e_873510_280822' ,
2457 'tag_200_subfield_e_873510_280822' ,
2458 'tag_200_code_f_873510_110730' ,
2459 'tag_200_subfield_f_873510_110730' ,
2461 L<$record> is the MARC::Record object.
2465 sub TransformHtmlToMarc {
2466 my ($cgi, $isbiblio) = @_;
2468 my @params = $cgi->multi_param();
2470 # explicitly turn on the UTF-8 flag for all
2471 # 'tag_' parameters to avoid incorrect character
2472 # conversion later on
2473 my $cgi_params = $cgi->Vars;
2474 foreach my $param_name ( keys %$cgi_params ) {
2475 if ( $param_name =~ /^tag_/ ) {
2476 my $param_value = $cgi_params->{$param_name};
2477 unless ( Encode::is_utf8( $param_value ) ) {
2478 $cgi_params->{$param_name} = Encode::decode('UTF-8', $param_value );
2483 # creating a new record
2484 my $record = MARC::Record->new();
2486 my ($biblionumbertagfield, $biblionumbertagsubfield) = (-1, -1);
2487 ($biblionumbertagfield, $biblionumbertagsubfield) =
2488 &GetMarcFromKohaField( "biblio.biblionumber", '' ) if $isbiblio;
2489 #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!
2490 for (my $i = 0; $params[$i]; $i++ ) { # browse all CGI params
2491 my $param = $params[$i];
2494 # if we are on biblionumber, store it in the MARC::Record (it may not be in the edited fields)
2495 if ( $param eq 'biblionumber' ) {
2496 if ( $biblionumbertagfield < 10 ) {
2497 $newfield = MARC::Field->new( $biblionumbertagfield, scalar $cgi->param($param), );
2499 $newfield = MARC::Field->new( $biblionumbertagfield, '', '', "$biblionumbertagsubfield" => scalar $cgi->param($param), );
2501 push @fields, $newfield if ($newfield);
2502 } elsif ( $param =~ /^tag_(\d*)_indicator1_/ ) { # new field start when having 'input name="..._indicator1_..."
2505 my $ind1 = _default_ind_to_space( substr( $cgi->param($param), 0, 1 ) );
2506 my $ind2 = _default_ind_to_space( substr( $cgi->param( $params[ $i + 1 ] ), 0, 1 ) );
2510 if ( $tag < 10 ) { # no code for theses fields
2511 # in MARC editor, 000 contains the leader.
2512 next if $tag == $biblionumbertagfield;
2513 my $fval= $cgi->param($params[$j+1]);
2514 if ( $tag eq '000' ) {
2515 # Force a fake leader even if not provided to avoid crashing
2516 # during decoding MARC record containing UTF-8 characters
2518 length( $fval ) == 24
2523 # between 001 and 009 (included)
2524 } elsif ( $fval ne '' ) {
2525 $newfield = MARC::Field->new( $tag, $fval, );
2528 # > 009, deal with subfields
2530 # browse subfields for this tag (reason for _code_ match)
2531 while(defined $params[$j] && $params[$j] =~ /_code_/) {
2532 last unless defined $params[$j+1];
2534 if $tag == $biblionumbertagfield and
2535 $cgi->param($params[$j]) eq $biblionumbertagsubfield;
2536 #if next param ne subfield, then it was probably empty
2537 #try next param by incrementing j
2538 if($params[$j+1]!~/_subfield_/) {$j++; next; }
2539 my $fkey= $cgi->param($params[$j]);
2540 my $fval= $cgi->param($params[$j+1]);
2541 #check if subfield value not empty and field exists
2542 if($fval ne '' && $newfield) {
2543 $newfield->add_subfields( $fkey => $fval);
2545 elsif($fval ne '') {
2546 $newfield = MARC::Field->new( $tag, $ind1, $ind2, $fkey => $fval );
2550 $i= $j-1; #update i for outer loop accordingly
2552 push @fields, $newfield if ($newfield);
2556 $record->append_fields(@fields);
2560 =head2 TransformMarcToKoha
2562 $result = TransformMarcToKoha( $record, $frameworkcode )
2564 Extract data from a MARC bib record into a hashref representing
2565 Koha biblio, biblioitems, and items fields.
2567 If passed an undefined record will log the error and return an empty
2572 sub TransformMarcToKoha {
2573 my ( $record, $frameworkcode, $limit_table ) = @_;
2576 if (!defined $record) {
2577 carp('TransformMarcToKoha called with undefined record');
2580 $limit_table = $limit_table || 0;
2581 $frameworkcode = '' unless defined $frameworkcode;
2583 my $inverted_field_map = _get_inverted_marc_field_map($frameworkcode);
2586 if ( defined $limit_table && $limit_table eq 'items' ) {
2587 $tables{'items'} = 1;
2589 $tables{'items'} = 1;
2590 $tables{'biblio'} = 1;
2591 $tables{'biblioitems'} = 1;
2594 # traverse through record
2595 MARCFIELD: foreach my $field ( $record->fields() ) {
2596 my $tag = $field->tag();
2597 next MARCFIELD unless exists $inverted_field_map->{$tag};
2598 if ( $field->is_control_field() ) {
2599 my $kohafields = $inverted_field_map->{$tag}->{list};
2600 ENTRY: foreach my $entry ( @{$kohafields} ) {
2601 my ( $subfield, $table, $column ) = @{$entry};
2602 next ENTRY unless exists $tables{$table};
2603 my $key = _disambiguate( $table, $column );
2604 if ( $result->{$key} ) {
2605 unless ( ( $key eq "biblionumber" or $key eq "biblioitemnumber" ) and ( $field->data() eq "" ) ) {
2606 $result->{$key} .= " | " . $field->data();
2609 $result->{$key} = $field->data();
2614 # deal with subfields
2615 MARCSUBFIELD: foreach my $sf ( $field->subfields() ) {
2616 my $code = $sf->[0];
2617 next MARCSUBFIELD unless exists $inverted_field_map->{$tag}->{sfs}->{$code};
2618 my $value = $sf->[1];
2619 SFENTRY: foreach my $entry ( @{ $inverted_field_map->{$tag}->{sfs}->{$code} } ) {
2620 my ( $table, $column ) = @{$entry};
2621 next SFENTRY unless exists $tables{$table};
2622 my $key = _disambiguate( $table, $column );
2623 if ( $result->{$key} ) {
2624 unless ( ( $key eq "biblionumber" or $key eq "biblioitemnumber" ) and ( $value eq "" ) ) {
2625 $result->{$key} .= " | " . $value;
2628 $result->{$key} = $value;
2635 # modify copyrightdate to keep only the 1st year found
2636 if ( exists $result->{'copyrightdate'} ) {
2637 my $temp = $result->{'copyrightdate'};
2638 $temp =~ m/c(\d\d\d\d)/;
2639 if ( $temp =~ m/c(\d\d\d\d)/ and $1 > 0 ) { # search cYYYY first
2640 $result->{'copyrightdate'} = $1;
2641 } else { # if no cYYYY, get the 1st date.
2642 $temp =~ m/(\d\d\d\d)/;
2643 $result->{'copyrightdate'} = $1;
2647 # modify publicationyear to keep only the 1st year found
2648 if ( exists $result->{'publicationyear'} ) {
2649 my $temp = $result->{'publicationyear'};
2650 if ( $temp =~ m/c(\d\d\d\d)/ and $1 > 0 ) { # search cYYYY first
2651 $result->{'publicationyear'} = $1;
2652 } else { # if no cYYYY, get the 1st date.
2653 $temp =~ m/(\d\d\d\d)/;
2654 $result->{'publicationyear'} = $1;
2661 sub _get_inverted_marc_field_map {
2662 my ( $frameworkcode ) = @_;
2664 my $mss = GetMarcSubfieldStructure( $frameworkcode );
2666 foreach my $kohafield ( keys %{ $mss } ) {
2667 next unless exists $mss->{$kohafield}; # not all columns are mapped to MARC tag & subfield
2668 my $tag = $mss->{$kohafield}{tagfield};
2669 my $subfield = $mss->{$kohafield}{tagsubfield};
2670 my ( $table, $column ) = split /[.]/, $kohafield, 2;
2671 push @{ $field_map->{$tag}->{list} }, [ $subfield, $table, $column ];
2672 push @{ $field_map->{$tag}->{sfs}->{$subfield} }, [ $table, $column ];
2677 =head2 _disambiguate
2679 $newkey = _disambiguate($table, $field);
2681 This is a temporary hack to distinguish between the
2682 following sets of columns when using TransformMarcToKoha.
2684 items.cn_source & biblioitems.cn_source
2685 items.cn_sort & biblioitems.cn_sort
2687 Columns that are currently NOT distinguished (FIXME
2688 due to lack of time to fully test) are:
2690 biblio.notes and biblioitems.notes
2695 FIXME - this is necessary because prefixing each column
2696 name with the table name would require changing lots
2697 of code and templates, and exposing more of the DB
2698 structure than is good to the UI templates, particularly
2699 since biblio and bibloitems may well merge in a future
2700 version. In the future, it would also be good to
2701 separate DB access and UI presentation field names
2706 sub CountItemsIssued {
2707 my ($biblionumber) = @_;
2708 my $dbh = C4::Context->dbh;
2709 my $sth = $dbh->prepare('SELECT COUNT(*) as issuedCount FROM items, issues WHERE items.itemnumber = issues.itemnumber AND items.biblionumber = ?');
2710 $sth->execute($biblionumber);
2711 my $row = $sth->fetchrow_hashref();
2712 return $row->{'issuedCount'};
2716 my ( $table, $column ) = @_;
2717 if ( $column eq "cn_sort" or $column eq "cn_source" ) {
2718 return $table . '.' . $column;
2725 =head2 get_koha_field_from_marc
2727 $result->{_disambiguate($table, $field)} =
2728 get_koha_field_from_marc($table,$field,$record,$frameworkcode);
2730 Internal function to map data from the MARC record to a specific non-MARC field.
2731 FIXME: this is meant to replace TransformMarcToKohaOneField after more testing.
2735 sub get_koha_field_from_marc {
2736 my ( $koha_table, $koha_column, $record, $frameworkcode ) = @_;
2737 my ( $tagfield, $subfield ) = GetMarcFromKohaField( $koha_table . '.' . $koha_column, $frameworkcode );
2739 foreach my $field ( $record->field($tagfield) ) {
2740 if ( $field->tag() < 10 ) {
2742 $kohafield .= " | " . $field->data();
2744 $kohafield = $field->data();
2747 if ( $field->subfields ) {
2748 my @subfields = $field->subfields();
2749 foreach my $subfieldcount ( 0 .. $#subfields ) {
2750 if ( $subfields[$subfieldcount][0] eq $subfield ) {
2752 $kohafield .= " | " . $subfields[$subfieldcount][1];
2754 $kohafield = $subfields[$subfieldcount][1];
2764 =head2 TransformMarcToKohaOneField
2766 $result = TransformMarcToKohaOneField( $kohatable, $kohafield, $record, $result, $frameworkcode )
2770 sub TransformMarcToKohaOneField {
2772 # FIXME ? if a field has a repeatable subfield that is used in old-db,
2773 # only the 1st will be retrieved...
2774 my ( $kohatable, $kohafield, $record, $result, $frameworkcode ) = @_;
2776 my ( $tagfield, $subfield ) = GetMarcFromKohaField( $kohatable . "." . $kohafield, $frameworkcode );
2777 foreach my $field ( $record->field($tagfield) ) {
2778 if ( $field->tag() < 10 ) {
2779 if ( $result->{$kohafield} ) {
2780 $result->{$kohafield} .= " | " . $field->data();
2782 $result->{$kohafield} = $field->data();
2785 if ( $field->subfields ) {
2786 my @subfields = $field->subfields();
2787 foreach my $subfieldcount ( 0 .. $#subfields ) {
2788 if ( $subfields[$subfieldcount][0] eq $subfield ) {
2789 if ( $result->{$kohafield} ) {
2790 $result->{$kohafield} .= " | " . $subfields[$subfieldcount][1];
2792 $result->{$kohafield} = $subfields[$subfieldcount][1];
2806 # true ModZebra commented until indexdata fixes zebraDB crashes (it seems they occur on multiple updates
2808 # replaced by a zebraqueue table, that is filled with ModZebra to run.
2809 # the table is emptied by misc/cronjobs/zebraqueue_start.pl script
2810 # =head2 ModZebrafiles
2812 # &ModZebrafiles( $dbh, $biblionumber, $record, $folder, $server );
2816 # sub ModZebrafiles {
2818 # my ( $dbh, $biblionumber, $record, $folder, $server ) = @_;
2822 # C4::Context->zebraconfig($server)->{directory} . "/" . $folder . "/";
2823 # unless ( opendir( DIR, "$zebradir" ) ) {
2824 # warn "$zebradir not found";
2828 # my $filename = $zebradir . $biblionumber;
2831 # open( OUTPUT, ">", $filename . ".xml" );
2832 # print OUTPUT $record;
2839 ModZebra( $biblionumber, $op, $server, $record );
2841 $biblionumber is the biblionumber we want to index
2843 $op is specialUpdate or recordDelete, and is used to know what we want to do
2845 $server is the server that we want to update
2847 $record is the update MARC record if it's available. If it's not supplied
2848 and is needed, it'll be loaded from the database.
2853 ###Accepts a $server variable thus we can use it for biblios authorities or other zebra dbs
2854 my ( $biblionumber, $op, $server, $record ) = @_;
2855 $debug && warn "ModZebra: update requested for: $biblionumber $op $server\n";
2856 if ( C4::Context->preference('SearchEngine') eq 'Elasticsearch' ) {
2858 # TODO abstract to a standard API that'll work for whatever
2859 require Koha::SearchEngine::Elasticsearch::Indexer;
2860 my $indexer = Koha::SearchEngine::Elasticsearch::Indexer->new(
2862 index => $server eq 'biblioserver'
2863 ? $Koha::SearchEngine::BIBLIOS_INDEX
2864 : $Koha::SearchEngine::AUTHORITIES_INDEX
2867 if ( $op eq 'specialUpdate' ) {
2869 $record = GetMarcBiblio($biblionumber, 1);
2871 my $records = [$record];
2872 $indexer->update_index_background( [$biblionumber], [$record] );
2874 elsif ( $op eq 'recordDelete' ) {
2875 $indexer->delete_index_background( [$biblionumber] );
2878 croak "ModZebra called with unknown operation: $op";
2882 my $dbh = C4::Context->dbh;
2884 # true ModZebra commented until indexdata fixes zebraDB crashes (it seems they occur on multiple updates
2886 # replaced by a zebraqueue table, that is filled with ModZebra to run.
2887 # the table is emptied by rebuild_zebra.pl script (using the -z switch)
2888 my $check_sql = "SELECT COUNT(*) FROM zebraqueue
2890 AND biblio_auth_number = ?
2893 my $check_sth = $dbh->prepare_cached($check_sql);
2894 $check_sth->execute( $server, $biblionumber, $op );
2895 my ($count) = $check_sth->fetchrow_array;
2896 $check_sth->finish();
2897 if ( $count == 0 ) {
2898 my $sth = $dbh->prepare("INSERT INTO zebraqueue (biblio_auth_number,server,operation) VALUES(?,?,?)");
2899 $sth->execute( $biblionumber, $server, $op );
2905 =head2 EmbedItemsInMarcBiblio
2907 EmbedItemsInMarcBiblio($marc, $biblionumber, $itemnumbers, $opac);
2909 Given a MARC::Record object containing a bib record,
2910 modify it to include the items attached to it as 9XX
2911 per the bib's MARC framework.
2912 if $itemnumbers is defined, only specified itemnumbers are embedded.
2914 If $opac is true, then opac-relevant suppressions are included.
2918 sub EmbedItemsInMarcBiblio {
2919 my ($marc, $biblionumber, $itemnumbers, $opac) = @_;
2921 carp 'EmbedItemsInMarcBiblio: No MARC record passed';
2925 $itemnumbers = [] unless defined $itemnumbers;
2927 my $frameworkcode = GetFrameworkCode($biblionumber);
2928 _strip_item_fields($marc, $frameworkcode);
2930 # ... and embed the current items
2931 my $dbh = C4::Context->dbh;
2932 my $sth = $dbh->prepare("SELECT itemnumber FROM items WHERE biblionumber = ?");
2933 $sth->execute($biblionumber);
2935 my ( $itemtag, $itemsubfield ) = GetMarcFromKohaField( "items.itemnumber", $frameworkcode );
2937 my $opachiddenitems = $opac
2938 && ( C4::Context->preference('OpacHiddenItems') !~ /^\s*$/ );
2940 while ( my ($itemnumber) = $sth->fetchrow_array ) {
2941 next if @$itemnumbers and not grep { $_ == $itemnumber } @$itemnumbers;
2942 my $i = $opachiddenitems ? C4::Items::GetItem($itemnumber) : undef;
2943 push @items, { itemnumber => $itemnumber, item => $i };
2947 ? C4::Items::GetHiddenItemnumbers( map { $_->{item} } @items )
2949 # Convert to a hash for quick searching
2950 my %hiddenitems = map { $_ => 1 } @hiddenitems;
2951 foreach my $itemnumber ( map { $_->{itemnumber} } @items ) {
2952 next if $hiddenitems{$itemnumber};
2953 my $item_marc = C4::Items::GetMarcItem( $biblionumber, $itemnumber );
2954 push @item_fields, $item_marc->field($itemtag);
2956 $marc->append_fields(@item_fields);
2959 =head1 INTERNAL FUNCTIONS
2961 =head2 _koha_marc_update_bib_ids
2964 _koha_marc_update_bib_ids($record, $frameworkcode, $biblionumber, $biblioitemnumber);
2966 Internal function to add or update biblionumber and biblioitemnumber to
2971 sub _koha_marc_update_bib_ids {
2972 my ( $record, $frameworkcode, $biblionumber, $biblioitemnumber ) = @_;
2974 my ( $biblio_tag, $biblio_subfield ) = GetMarcFromKohaField( "biblio.biblionumber", $frameworkcode );
2975 die qq{No biblionumber tag for framework "$frameworkcode"} unless $biblio_tag;
2976 my ( $biblioitem_tag, $biblioitem_subfield ) = GetMarcFromKohaField( "biblioitems.biblioitemnumber", $frameworkcode );
2977 die qq{No biblioitemnumber tag for framework "$frameworkcode"} unless $biblioitem_tag;
2979 if ( $biblio_tag < 10 ) {
2980 C4::Biblio::UpsertMarcControlField( $record, $biblio_tag, $biblionumber );
2982 C4::Biblio::UpsertMarcSubfield($record, $biblio_tag, $biblio_subfield, $biblionumber);
2984 if ( $biblioitem_tag < 10 ) {
2985 C4::Biblio::UpsertMarcControlField( $record, $biblioitem_tag, $biblioitemnumber );
2987 C4::Biblio::UpsertMarcSubfield($record, $biblioitem_tag, $biblioitem_subfield, $biblioitemnumber);
2991 =head2 _koha_marc_update_biblioitem_cn_sort
2993 _koha_marc_update_biblioitem_cn_sort($marc, $biblioitem, $frameworkcode);
2995 Given a MARC bib record and the biblioitem hash, update the
2996 subfield that contains a copy of the value of biblioitems.cn_sort.
3000 sub _koha_marc_update_biblioitem_cn_sort {
3002 my $biblioitem = shift;
3003 my $frameworkcode = shift;
3005 my ( $biblioitem_tag, $biblioitem_subfield ) = GetMarcFromKohaField( "biblioitems.cn_sort", $frameworkcode );
3006 return unless $biblioitem_tag;
3008 my ($cn_sort) = GetClassSort( $biblioitem->{'biblioitems.cn_source'}, $biblioitem->{'cn_class'}, $biblioitem->{'cn_item'} );
3010 if ( my $field = $marc->field($biblioitem_tag) ) {
3011 $field->delete_subfield( code => $biblioitem_subfield );
3012 if ( $cn_sort ne '' ) {
3013 $field->add_subfields( $biblioitem_subfield => $cn_sort );
3017 # if we get here, no biblioitem tag is present in the MARC record, so
3018 # we'll create it if $cn_sort is not empty -- this would be
3019 # an odd combination of events, however
3021 $marc->insert_grouped_field( MARC::Field->new( $biblioitem_tag, ' ', ' ', $biblioitem_subfield => $cn_sort ) );
3026 =head2 _koha_add_biblio
3028 my ($biblionumber,$error) = _koha_add_biblio($dbh,$biblioitem);
3030 Internal function to add a biblio ($biblio is a hash with the values)
3034 sub _koha_add_biblio {
3035 my ( $dbh, $biblio, $frameworkcode ) = @_;
3039 # set the series flag
3040 unless (defined $biblio->{'serial'}){
3041 $biblio->{'serial'} = 0;
3042 if ( $biblio->{'seriestitle'} ) { $biblio->{'serial'} = 1 }
3045 my $query = "INSERT INTO biblio
3046 SET frameworkcode = ?,
3057 my $sth = $dbh->prepare($query);
3059 $frameworkcode, $biblio->{'author'}, $biblio->{'title'}, $biblio->{'unititle'}, $biblio->{'notes'},
3060 $biblio->{'serial'}, $biblio->{'seriestitle'}, $biblio->{'copyrightdate'}, $biblio->{'abstract'}
3063 my $biblionumber = $dbh->{'mysql_insertid'};
3064 if ( $dbh->errstr ) {
3065 $error .= "ERROR in _koha_add_biblio $query" . $dbh->errstr;
3071 #warn "LEAVING _koha_add_biblio: ".$biblionumber."\n";
3072 return ( $biblionumber, $error );
3075 =head2 _koha_modify_biblio
3077 my ($biblionumber,$error) == _koha_modify_biblio($dbh,$biblio,$frameworkcode);
3079 Internal function for updating the biblio table
3083 sub _koha_modify_biblio {
3084 my ( $dbh, $biblio, $frameworkcode ) = @_;
3089 SET frameworkcode = ?,
3098 WHERE biblionumber = ?
3101 my $sth = $dbh->prepare($query);
3104 $frameworkcode, $biblio->{'author'}, $biblio->{'title'}, $biblio->{'unititle'}, $biblio->{'notes'},
3105 $biblio->{'serial'}, $biblio->{'seriestitle'}, $biblio->{'copyrightdate'}, $biblio->{'abstract'}, $biblio->{'biblionumber'}
3106 ) if $biblio->{'biblionumber'};
3108 if ( $dbh->errstr || !$biblio->{'biblionumber'} ) {
3109 $error .= "ERROR in _koha_modify_biblio $query" . $dbh->errstr;
3112 return ( $biblio->{'biblionumber'}, $error );
3115 =head2 _koha_modify_biblioitem_nonmarc
3117 my ($biblioitemnumber,$error) = _koha_modify_biblioitem_nonmarc( $dbh, $biblioitem );
3121 sub _koha_modify_biblioitem_nonmarc {
3122 my ( $dbh, $biblioitem ) = @_;
3125 # re-calculate the cn_sort, it may have changed
3126 my ($cn_sort) = GetClassSort( $biblioitem->{'biblioitems.cn_source'}, $biblioitem->{'cn_class'}, $biblioitem->{'cn_item'} );
3128 my $query = "UPDATE biblioitems
3129 SET biblionumber = ?,
3135 publicationyear = ?,
3139 collectiontitle = ?,
3141 collectionvolume= ?,
3142 editionstatement= ?,
3143 editionresponsibility = ?,
3159 where biblioitemnumber = ?
3161 my $sth = $dbh->prepare($query);
3163 $biblioitem->{'biblionumber'}, $biblioitem->{'volume'}, $biblioitem->{'number'}, $biblioitem->{'itemtype'},
3164 $biblioitem->{'isbn'}, $biblioitem->{'issn'}, $biblioitem->{'publicationyear'}, $biblioitem->{'publishercode'},
3165 $biblioitem->{'volumedate'}, $biblioitem->{'volumedesc'}, $biblioitem->{'collectiontitle'}, $biblioitem->{'collectionissn'},
3166 $biblioitem->{'collectionvolume'}, $biblioitem->{'editionstatement'}, $biblioitem->{'editionresponsibility'}, $biblioitem->{'illus'},
3167 $biblioitem->{'pages'}, $biblioitem->{'bnotes'}, $biblioitem->{'size'}, $biblioitem->{'place'},
3168 $biblioitem->{'lccn'}, $biblioitem->{'url'}, $biblioitem->{'biblioitems.cn_source'}, $biblioitem->{'cn_class'},
3169 $biblioitem->{'cn_item'}, $biblioitem->{'cn_suffix'}, $cn_sort, $biblioitem->{'totalissues'},
3170 $biblioitem->{'ean'}, $biblioitem->{'agerestriction'}, $biblioitem->{'biblioitemnumber'}
3172 if ( $dbh->errstr ) {
3173 $error .= "ERROR in _koha_modify_biblioitem_nonmarc $query" . $dbh->errstr;
3176 return ( $biblioitem->{'biblioitemnumber'}, $error );
3179 =head2 _koha_add_biblioitem
3181 my ($biblioitemnumber,$error) = _koha_add_biblioitem( $dbh, $biblioitem );
3183 Internal function to add a biblioitem
3187 sub _koha_add_biblioitem {
3188 my ( $dbh, $biblioitem ) = @_;
3191 my ($cn_sort) = GetClassSort( $biblioitem->{'biblioitems.cn_source'}, $biblioitem->{'cn_class'}, $biblioitem->{'cn_item'} );
3192 my $query = "INSERT INTO biblioitems SET
3199 publicationyear = ?,
3203 collectiontitle = ?,
3205 collectionvolume= ?,
3206 editionstatement= ?,
3207 editionresponsibility = ?,
3224 my $sth = $dbh->prepare($query);
3226 $biblioitem->{'biblionumber'}, $biblioitem->{'volume'}, $biblioitem->{'number'}, $biblioitem->{'itemtype'},
3227 $biblioitem->{'isbn'}, $biblioitem->{'issn'}, $biblioitem->{'publicationyear'}, $biblioitem->{'publishercode'},
3228 $biblioitem->{'volumedate'}, $biblioitem->{'volumedesc'}, $biblioitem->{'collectiontitle'}, $biblioitem->{'collectionissn'},
3229 $biblioitem->{'collectionvolume'}, $biblioitem->{'editionstatement'}, $biblioitem->{'editionresponsibility'}, $biblioitem->{'illus'},
3230 $biblioitem->{'pages'}, $biblioitem->{'bnotes'}, $biblioitem->{'size'}, $biblioitem->{'place'},
3231 $biblioitem->{'lccn'}, $biblioitem->{'url'}, $biblioitem->{'biblioitems.cn_source'},
3232 $biblioitem->{'cn_class'}, $biblioitem->{'cn_item'}, $biblioitem->{'cn_suffix'}, $cn_sort,
3233 $biblioitem->{'totalissues'}, $biblioitem->{'ean'}, $biblioitem->{'agerestriction'}
3235 my $bibitemnum = $dbh->{'mysql_insertid'};
3237 if ( $dbh->errstr ) {
3238 $error .= "ERROR in _koha_add_biblioitem $query" . $dbh->errstr;
3242 return ( $bibitemnum, $error );
3245 =head2 _koha_delete_biblio
3247 $error = _koha_delete_biblio($dbh,$biblionumber);
3249 Internal sub for deleting from biblio table -- also saves to deletedbiblio
3251 C<$dbh> - the database handle
3253 C<$biblionumber> - the biblionumber of the biblio to be deleted
3257 # FIXME: add error handling
3259 sub _koha_delete_biblio {
3260 my ( $dbh, $biblionumber ) = @_;
3262 # get all the data for this biblio
3263 my $sth = $dbh->prepare("SELECT * FROM biblio WHERE biblionumber=?");
3264 $sth->execute($biblionumber);
3266 # FIXME There is a transaction in _koha_delete_biblio_metadata
3267 # But actually all the following should be done inside a single transaction
3268 if ( my $data = $sth->fetchrow_hashref ) {
3270 # save the record in deletedbiblio
3271 # find the fields to save
3272 my $query = "INSERT INTO deletedbiblio SET ";
3274 foreach my $temp ( keys %$data ) {
3275 $query .= "$temp = ?,";
3276 push( @bind, $data->{$temp} );
3279 # replace the last , by ",?)"
3281 my $bkup_sth = $dbh->prepare($query);
3282 $bkup_sth->execute(@bind);
3285 _koha_delete_biblio_metadata( $biblionumber );
3288 my $sth2 = $dbh->prepare("DELETE FROM biblio WHERE biblionumber=?");
3289 $sth2->execute($biblionumber);
3290 # update the timestamp (Bugzilla 7146)
3291 $sth2= $dbh->prepare("UPDATE deletedbiblio SET timestamp=NOW() WHERE biblionumber=?");
3292 $sth2->execute($biblionumber);
3299 =head2 _koha_delete_biblioitems
3301 $error = _koha_delete_biblioitems($dbh,$biblioitemnumber);
3303 Internal sub for deleting from biblioitems table -- also saves to deletedbiblioitems
3305 C<$dbh> - the database handle
3306 C<$biblionumber> - the biblioitemnumber of the biblioitem to be deleted
3310 # FIXME: add error handling
3312 sub _koha_delete_biblioitems {
3313 my ( $dbh, $biblioitemnumber ) = @_;
3315 # get all the data for this biblioitem
3316 my $sth = $dbh->prepare("SELECT * FROM biblioitems WHERE biblioitemnumber=?");
3317 $sth->execute($biblioitemnumber);
3319 if ( my $data = $sth->fetchrow_hashref ) {
3321 # save the record in deletedbiblioitems
3322 # find the fields to save
3323 my $query = "INSERT INTO deletedbiblioitems SET ";
3325 foreach my $temp ( keys %$data ) {
3326 $query .= "$temp = ?,";
3327 push( @bind, $data->{$temp} );
3330 # replace the last , by ",?)"
3332 my $bkup_sth = $dbh->prepare($query);
3333 $bkup_sth->execute(@bind);
3336 # delete the biblioitem
3337 my $sth2 = $dbh->prepare("DELETE FROM biblioitems WHERE biblioitemnumber=?");
3338 $sth2->execute($biblioitemnumber);
3339 # update the timestamp (Bugzilla 7146)
3340 $sth2= $dbh->prepare("UPDATE deletedbiblioitems SET timestamp=NOW() WHERE biblioitemnumber=?");
3341 $sth2->execute($biblioitemnumber);
3348 =head2 _koha_delete_biblio_metadata
3350 $error = _koha_delete_biblio_metadata($biblionumber);
3352 C<$biblionumber> - the biblionumber of the biblio metadata to be deleted
3356 sub _koha_delete_biblio_metadata {
3357 my ($biblionumber) = @_;
3359 my $dbh = C4::Context->dbh;
3360 my $schema = Koha::Database->new->schema;
3364 INSERT INTO deletedbiblio_metadata (biblionumber, format, marcflavour, metadata)
3365 SELECT biblionumber, format, marcflavour, metadata FROM biblio_metadata WHERE biblionumber=?
3366 |, undef, $biblionumber );
3367 $dbh->do( q|DELETE FROM biblio_metadata WHERE biblionumber=?|,
3368 undef, $biblionumber );
3373 =head1 UNEXPORTED FUNCTIONS
3375 =head2 ModBiblioMarc
3377 &ModBiblioMarc($newrec,$biblionumber,$frameworkcode);
3379 Add MARC XML data for a biblio to koha
3381 Function exported, but should NOT be used, unless you really know what you're doing
3386 # pass the MARC::Record to this function, and it will create the records in
3388 my ( $record, $biblionumber, $frameworkcode ) = @_;
3390 carp 'ModBiblioMarc passed an undefined record';
3394 # Clone record as it gets modified
3395 $record = $record->clone();
3396 my $dbh = C4::Context->dbh;
3397 my @fields = $record->fields();
3398 if ( !$frameworkcode ) {
3399 $frameworkcode = "";
3401 my $sth = $dbh->prepare("UPDATE biblio SET frameworkcode=? WHERE biblionumber=?");
3402 $sth->execute( $frameworkcode, $biblionumber );
3404 my $encoding = C4::Context->preference("marcflavour");
3406 # deal with UNIMARC field 100 (encoding) : create it if needed & set encoding to unicode
3407 if ( $encoding eq "UNIMARC" ) {
3408 my $defaultlanguage = C4::Context->preference("UNIMARCField100Language");
3409 $defaultlanguage = "fre" if (!$defaultlanguage || length($defaultlanguage) != 3);
3410 my $string = $record->subfield( 100, "a" );
3411 if ( ($string) && ( length( $record->subfield( 100, "a" ) ) == 36 ) ) {
3412 my $f100 = $record->field(100);
3413 $record->delete_field($f100);
3415 $string = POSIX::strftime( "%Y%m%d", localtime );
3417 $string = sprintf( "%-*s", 35, $string );
3418 substr ( $string, 22, 3, $defaultlanguage);
3420 substr( $string, 25, 3, "y50" );
3421 unless ( $record->subfield( 100, "a" ) ) {
3422 $record->insert_fields_ordered( MARC::Field->new( 100, "", "", "a" => $string ) );
3426 #enhancement 5374: update transaction date (005) for marc21/unimarc
3427 if($encoding =~ /MARC21|UNIMARC/) {
3428 my @a= (localtime) [5,4,3,2,1,0]; $a[0]+=1900; $a[1]++;
3429 # YY MM DD HH MM SS (update year and month)
3430 my $f005= $record->field('005');
3431 $f005->update(sprintf("%4d%02d%02d%02d%02d%04.1f",@a)) if $f005;
3435 biblionumber => $biblionumber,
3436 format => 'marcxml',
3437 marcflavour => C4::Context->preference('marcflavour'),
3439 # FIXME To replace with ->find_or_create?
3440 if ( my $m_rs = Koha::Biblio::Metadatas->find($metadata) ) {
3441 $m_rs->metadata( $record->as_xml_record($encoding) );
3444 my $m_rs = Koha::Biblio::Metadata->new($metadata);
3445 $m_rs->metadata( $record->as_xml_record($encoding) );
3448 ModZebra( $biblionumber, "specialUpdate", "biblioserver", $record );
3449 return $biblionumber;
3452 =head2 CountBiblioInOrders
3454 $count = &CountBiblioInOrders( $biblionumber);
3456 This function return count of biblios in orders with $biblionumber
3460 sub CountBiblioInOrders {
3461 my ($biblionumber) = @_;
3462 my $dbh = C4::Context->dbh;
3463 my $query = "SELECT count(*)
3465 WHERE biblionumber=? AND (datecancellationprinted IS NULL OR datecancellationprinted='0000-00-00')";
3466 my $sth = $dbh->prepare($query);
3467 $sth->execute($biblionumber);
3468 my $count = $sth->fetchrow;
3472 =head2 GetSubscriptionsId
3474 $subscriptions = &GetSubscriptionsId($biblionumber);
3476 This function return an array of subscriptionid with $biblionumber
3480 sub GetSubscriptionsId {
3481 my ($biblionumber) = @_;
3482 my $dbh = C4::Context->dbh;
3483 my $query = "SELECT subscriptionid
3485 WHERE biblionumber=?";
3486 my $sth = $dbh->prepare($query);
3487 $sth->execute($biblionumber);
3488 my @subscriptions = $sth->fetchrow_array;
3489 return (@subscriptions);
3492 =head2 prepare_host_field
3494 $marcfield = prepare_host_field( $hostbiblioitem, $marcflavour );
3495 Generate the host item entry for an analytic child entry
3499 sub prepare_host_field {
3500 my ( $hostbiblio, $marcflavour ) = @_;
3501 $marcflavour ||= C4::Context->preference('marcflavour');
3502 my $host = GetMarcBiblio($hostbiblio);
3503 # unfortunately as_string does not 'do the right thing'
3504 # if field returns undef
3508 if ( $marcflavour eq 'MARC21' || $marcflavour eq 'NORMARC' ) {
3509 if ( $field = $host->field('100') || $host->field('110') || $host->field('11') ) {
3510 my $s = $field->as_string('ab');
3515 if ( $field = $host->field('245') ) {
3516 my $s = $field->as_string('a');
3521 if ( $field = $host->field('260') ) {
3522 my $s = $field->as_string('abc');
3527 if ( $field = $host->field('240') ) {
3528 my $s = $field->as_string();
3533 if ( $field = $host->field('022') ) {
3534 my $s = $field->as_string('a');
3539 if ( $field = $host->field('020') ) {
3540 my $s = $field->as_string('a');
3545 if ( $field = $host->field('001') ) {
3546 $sfd{w} = $field->data(),;
3548 $host_field = MARC::Field->new( 773, '0', ' ', %sfd );
3551 elsif ( $marcflavour eq 'UNIMARC' ) {
3553 if ( $field = $host->field('700') || $host->field('710') || $host->field('720') ) {
3554 my $s = $field->as_string('ab');
3560 if ( $field = $host->field('200') ) {
3561 my $s = $field->as_string('a');
3566 #place of publicaton
3567 if ( $field = $host->field('210') ) {
3568 my $s = $field->as_string('a');
3573 #date of publication
3574 if ( $field = $host->field('210') ) {
3575 my $s = $field->as_string('d');
3581 if ( $field = $host->field('205') ) {
3582 my $s = $field->as_string();
3588 if ( $field = $host->field('856') ) {
3589 my $s = $field->as_string('u');
3595 if ( $field = $host->field('011') ) {
3596 my $s = $field->as_string('a');
3602 if ( $field = $host->field('010') ) {
3603 my $s = $field->as_string('a');
3608 if ( $field = $host->field('001') ) {
3609 $sfd{0} = $field->data(),;
3611 $host_field = MARC::Field->new( 461, '0', ' ', %sfd );
3618 =head2 UpdateTotalIssues
3620 UpdateTotalIssues($biblionumber, $increase, [$value])
3622 Update the total issue count for a particular bib record.
3626 =item C<$biblionumber> is the biblionumber of the bib to update
3628 =item C<$increase> is the amount to increase (or decrease) the total issues count by
3630 =item C<$value> is the absolute value that total issues count should be set to. If provided, C<$increase> is ignored.
3636 sub UpdateTotalIssues {
3637 my ($biblionumber, $increase, $value) = @_;
3640 my $record = GetMarcBiblio($biblionumber);
3642 carp "UpdateTotalIssues could not get biblio record";
3645 my $data = GetBiblioData($biblionumber);
3647 carp "UpdateTotalIssues could not get datas of biblio";
3650 my ($totalissuestag, $totalissuessubfield) = GetMarcFromKohaField('biblioitems.totalissues', $data->{'frameworkcode'});
3651 unless ($totalissuestag) {
3652 return 1; # There is nothing to do
3655 if (defined $value) {
3656 $totalissues = $value;
3658 $totalissues = $data->{'totalissues'} + $increase;
3661 my $field = $record->field($totalissuestag);
3662 if (defined $field) {
3663 $field->update( $totalissuessubfield => $totalissues );
3665 $field = MARC::Field->new($totalissuestag, '0', '0',
3666 $totalissuessubfield => $totalissues);
3667 $record->insert_grouped_field($field);
3670 return ModBiblio($record, $biblionumber, $data->{'frameworkcode'});
3675 &RemoveAllNsb($record);
3677 Removes all nsb/nse chars from a record
3684 carp 'RemoveAllNsb called with undefined record';
3688 SetUTF8Flag($record);
3690 foreach my $field ($record->fields()) {
3691 if ($field->is_control_field()) {
3692 $field->update(nsb_clean($field->data()));
3694 my @subfields = $field->subfields();
3696 foreach my $subfield (@subfields) {
3697 push @new_subfields, $subfield->[0] => nsb_clean($subfield->[1]);
3699 if (scalar(@new_subfields) > 0) {
3702 $new_field = MARC::Field->new(
3704 $field->indicator(1),
3705 $field->indicator(2),
3710 warn "error in RemoveAllNsb : $@";
3712 $field->replace_with($new_field);
3728 Koha Development Team <http://koha-community.org/>
3730 Paul POULAIN paul.poulain@free.fr
3732 Joshua Ferraro jmf@liblime.com