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 under the
10 # terms of the GNU General Public License as published by the Free Software
11 # Foundation; either version 2 of the License, or (at your option) any later
14 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
15 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
16 # A PARTICULAR PURPOSE. See the GNU General Public License for more details.
18 # You should have received a copy of the GNU General Public License along
19 # with Koha; if not, write to the Free Software Foundation, Inc.,
20 # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
28 use MARC::File::USMARC;
30 use POSIX qw(strftime);
33 use C4::Dates qw/format_date/;
34 use C4::Log; # logaction
40 use vars qw($VERSION @ISA @EXPORT);
46 @ISA = qw( Exporter );
61 &GetBiblioItemByBiblioNumber
62 &GetBiblioFromItemNumber
63 &GetBiblionumberFromItemnumber
88 &GetAuthorisedValueDesc
101 # To modify something
108 # To delete something
113 # To link headings in a bib record
114 # to authority records.
117 &LinkBibHeadingsToAuthorities
121 # those functions are exported but should not be used
122 # they are usefull is few circumstances, so are exported.
123 # but don't use them unless you're a core developer ;-)
131 &TransformHtmlToMarc2
139 if (C4::Context->ismemcached) {
140 require Memoize::Memcached;
141 import Memoize::Memcached qw(memoize_memcached);
143 memoize_memcached( 'GetMarcStructure',
144 memcached => C4::Context->memcached);
150 C4::Biblio - cataloging management functions
154 Biblio.pm contains functions for managing storage and editing of bibliographic data within Koha. Most of the functions in this module are used for cataloging records: adding, editing, or removing biblios, biblioitems, or items. Koha's stores bibliographic information in three places:
158 =item 1. in the biblio,biblioitems,items, etc tables, which are limited to a one-to-one mapping to underlying MARC data
160 =item 2. as raw MARC in the Zebra index and storage engine
162 =item 3. as raw MARC the biblioitems.marc and biblioitems.marcxml
166 In the 3.0 version of Koha, the authoritative record-level information is in biblioitems.marcxml
168 Because the data isn't completely normalized there's a chance for information to get out of sync. The design choice to go with a un-normalized schema was driven by performance and stability concerns. However, if this occur, it can be considered as a bug : The API is (or should be) complete & the only entry point for all biblio/items managements.
172 =item 1. Compared with MySQL, Zebra is slow to update an index for small data changes -- especially for proc-intensive operations like circulation
174 =item 2. Zebra's index has been known to crash and a backup of the data is necessary to rebuild it in such cases
178 Because of this design choice, the process of managing storage and editing is a bit convoluted. Historically, Biblio.pm's grown to an unmanagable size and as a result we have several types of functions currently:
182 =item 1. Add*/Mod*/Del*/ - high-level external functions suitable for being called from external scripts to manage the collection
184 =item 2. _koha_* - low-level internal functions for managing the koha tables
186 =item 3. Marc management function : as the MARC record is stored in biblioitems.marc(xml), some subs dedicated to it's management are in this package. They should be used only internally by Biblio.pm, the only official entry points being AddBiblio, AddItem, ModBiblio, ModItem.
188 =item 4. Zebra functions used to update the Zebra index
190 =item 5. internal helper functions such as char_decode, checkitems, etc. Some of these probably belong in Koha.pm
194 The MARC record (in biblioitems.marcxml) contains the complete marc record, including items. It also contains the biblionumber. That is the reason why it is not stored directly by AddBiblio, with all other fields . To save a biblio, we need to :
198 =item 1. save datas in biblio and biblioitems table, that gives us a biblionumber and a biblioitemnumber
200 =item 2. add the biblionumber and biblioitemnumber into the MARC records
202 =item 3. save the marc record
206 When dealing with items, we must :
210 =item 1. save the item in items table, that gives us an itemnumber
212 =item 2. add the itemnumber to the item MARC field
214 =item 3. overwrite the MARC record (with the added item) into biblioitems.marc(xml)
216 When modifying a biblio or an item, the behaviour is quite similar.
220 =head1 EXPORTED FUNCTIONS
224 ($biblionumber,$biblioitemnumber) = AddBiblio($record,$frameworkcode);
226 Exported function (core API) for adding a new biblio to koha.
228 The first argument is a C<MARC::Record> object containing the
229 bib to add, while the second argument is the desired MARC
232 This function also accepts a third, optional argument: a hashref
233 to additional options. The only defined option is C<defer_marc_save>,
234 which if present and mapped to a true value, causes C<AddBiblio>
235 to omit the call to save the MARC in C<bibilioitems.marc>
236 and C<biblioitems.marcxml> This option is provided B<only>
237 for the use of scripts such as C<bulkmarcimport.pl> that may need
238 to do some manipulation of the MARC record for item parsing before
239 saving it and which cannot afford the performance hit of saving
240 the MARC record twice. Consequently, do not use that option
241 unless you can guarantee that C<ModBiblioMarc> will be called.
247 my $frameworkcode = shift;
248 my $options = @_ ? shift : undef;
249 my $defer_marc_save = 0;
250 if ( defined $options and exists $options->{'defer_marc_save'} and $options->{'defer_marc_save'} ) {
251 $defer_marc_save = 1;
254 my ( $biblionumber, $biblioitemnumber, $error );
255 my $dbh = C4::Context->dbh;
257 # transform the data into koha-table style data
258 SetUTF8Flag($record);
259 my $olddata = TransformMarcToKoha( $dbh, $record, $frameworkcode );
260 ( $biblionumber, $error ) = _koha_add_biblio( $dbh, $olddata, $frameworkcode );
261 $olddata->{'biblionumber'} = $biblionumber;
262 ( $biblioitemnumber, $error ) = _koha_add_biblioitem( $dbh, $olddata );
264 _koha_marc_update_bib_ids( $record, $frameworkcode, $biblionumber, $biblioitemnumber );
266 # update MARC subfield that stores biblioitems.cn_sort
267 _koha_marc_update_biblioitem_cn_sort( $record, $olddata, $frameworkcode );
270 ModBiblioMarc( $record, $biblionumber, $frameworkcode ) unless $defer_marc_save;
272 # update OAI-PMH sets
273 if(C4::Context->preference("OAI-PMH:AutoUpdateSets")) {
274 C4::OAI::Sets::UpdateOAISetsBiblio($biblionumber, $record);
277 logaction( "CATALOGUING", "ADD", $biblionumber, "biblio" ) if C4::Context->preference("CataloguingLog");
278 return ( $biblionumber, $biblioitemnumber );
283 ModBiblio( $record,$biblionumber,$frameworkcode);
285 Replace an existing bib record identified by C<$biblionumber>
286 with one supplied by the MARC::Record object C<$record>. The embedded
287 item, biblioitem, and biblionumber fields from the previous
288 version of the bib record replace any such fields of those tags that
289 are present in C<$record>. Consequently, ModBiblio() is not
290 to be used to try to modify item records.
292 C<$frameworkcode> specifies the MARC framework to use
293 when storing the modified bib record; among other things,
294 this controls how MARC fields get mapped to display columns
295 in the C<biblio> and C<biblioitems> tables, as well as
296 which fields are used to store embedded item, biblioitem,
297 and biblionumber data for indexing.
302 my ( $record, $biblionumber, $frameworkcode ) = @_;
303 croak "No record" unless $record;
305 if ( C4::Context->preference("CataloguingLog") ) {
306 my $newrecord = GetMarcBiblio($biblionumber);
307 logaction( "CATALOGUING", "MODIFY", $biblionumber, "BEFORE=>" . $newrecord->as_formatted );
310 # Cleaning up invalid fields must be done early or SetUTF8Flag is liable to
311 # throw an exception which probably won't be handled.
312 foreach my $field ($record->fields()) {
313 if (! $field->is_control_field()) {
314 if (scalar($field->subfields()) == 0 || (scalar($field->subfields()) == 1 && $field->subfield('9'))) {
315 $record->delete_field($field);
320 SetUTF8Flag($record);
321 my $dbh = C4::Context->dbh;
323 $frameworkcode = "" if !$frameworkcode || $frameworkcode eq "Default"; # XXX
325 _strip_item_fields($record, $frameworkcode);
327 # update biblionumber and biblioitemnumber in MARC
328 # FIXME - this is assuming a 1 to 1 relationship between
329 # biblios and biblioitems
330 my $sth = $dbh->prepare("select biblioitemnumber from biblioitems where biblionumber=?");
331 $sth->execute($biblionumber);
332 my ($biblioitemnumber) = $sth->fetchrow;
334 _koha_marc_update_bib_ids( $record, $frameworkcode, $biblionumber, $biblioitemnumber );
336 # load the koha-table data object
337 my $oldbiblio = TransformMarcToKoha( $dbh, $record, $frameworkcode );
339 # update MARC subfield that stores biblioitems.cn_sort
340 _koha_marc_update_biblioitem_cn_sort( $record, $oldbiblio, $frameworkcode );
342 # update the MARC record (that now contains biblio and items) with the new record data
343 &ModBiblioMarc( $record, $biblionumber, $frameworkcode );
345 # modify the other koha tables
346 _koha_modify_biblio( $dbh, $oldbiblio, $frameworkcode );
347 _koha_modify_biblioitem_nonmarc( $dbh, $oldbiblio );
349 # update OAI-PMH sets
350 if(C4::Context->preference("OAI-PMH:AutoUpdateSets")) {
351 C4::OAI::Sets::UpdateOAISetsBiblio($biblionumber, $record);
357 =head2 _strip_item_fields
359 _strip_item_fields($record, $frameworkcode)
361 Utility routine to remove item tags from a
366 sub _strip_item_fields {
368 my $frameworkcode = shift;
369 # get the items before and append them to the biblio before updating the record, atm we just have the biblio
370 my ( $itemtag, $itemsubfield ) = GetMarcFromKohaField( "items.itemnumber", $frameworkcode );
372 # delete any item fields from incoming record to avoid
373 # duplication or incorrect data - use AddItem() or ModItem()
375 foreach my $field ( $record->field($itemtag) ) {
376 $record->delete_field($field);
380 =head2 ModBiblioframework
382 ModBiblioframework($biblionumber,$frameworkcode);
384 Exported function to modify a biblio framework
388 sub ModBiblioframework {
389 my ( $biblionumber, $frameworkcode ) = @_;
390 my $dbh = C4::Context->dbh;
391 my $sth = $dbh->prepare( "UPDATE biblio SET frameworkcode=? WHERE biblionumber=?" );
392 $sth->execute( $frameworkcode, $biblionumber );
398 my $error = &DelBiblio($biblionumber);
400 Exported function (core API) for deleting a biblio in koha.
401 Deletes biblio record from Zebra and Koha tables (biblio,biblioitems,items)
402 Also backs it up to deleted* tables
403 Checks to make sure there are not issues on any of the items
405 C<$error> : undef unless an error occurs
410 my ($biblionumber) = @_;
411 my $dbh = C4::Context->dbh;
412 my $error; # for error handling
414 # First make sure this biblio has no items attached
415 my $sth = $dbh->prepare("SELECT itemnumber FROM items WHERE biblionumber=?");
416 $sth->execute($biblionumber);
417 if ( my $itemnumber = $sth->fetchrow ) {
419 # Fix this to use a status the template can understand
420 $error .= "This Biblio has items attached, please delete them first before deleting this biblio ";
423 return $error if $error;
425 # We delete attached subscriptions
427 my $subscriptions = C4::Serials::GetFullSubscriptionsFromBiblionumber($biblionumber);
428 foreach my $subscription (@$subscriptions) {
429 C4::Serials::DelSubscription( $subscription->{subscriptionid} );
432 # Delete in Zebra. Be careful NOT to move this line after _koha_delete_biblio
433 # for at least 2 reasons :
434 # - we need to read the biblio if NoZebra is set (to remove it from the indexes
435 # - if something goes wrong, the biblio may be deleted from Koha but not from zebra
436 # 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)
438 if ( C4::Context->preference("NoZebra") ) {
440 # only NoZebra indexing needs to have
441 # the previous version of the record
442 $oldRecord = GetMarcBiblio($biblionumber);
444 ModZebra( $biblionumber, "recordDelete", "biblioserver", $oldRecord, undef );
446 # delete biblioitems and items from Koha tables and save in deletedbiblioitems,deleteditems
447 $sth = $dbh->prepare("SELECT biblioitemnumber FROM biblioitems WHERE biblionumber=?");
448 $sth->execute($biblionumber);
449 while ( my $biblioitemnumber = $sth->fetchrow ) {
451 # delete this biblioitem
452 $error = _koha_delete_biblioitems( $dbh, $biblioitemnumber );
453 return $error if $error;
456 # delete biblio from Koha tables and save in deletedbiblio
457 # must do this *after* _koha_delete_biblioitems, otherwise
458 # delete cascade will prevent deletedbiblioitems rows
459 # from being generated by _koha_delete_biblioitems
460 $error = _koha_delete_biblio( $dbh, $biblionumber );
462 logaction( "CATALOGUING", "DELETE", $biblionumber, "" ) if C4::Context->preference("CataloguingLog");
468 =head2 BiblioAutoLink
470 my $headings_linked = BiblioAutoLink($record, $frameworkcode)
472 Automatically links headings in a bib record to authorities.
478 my $frameworkcode = shift;
479 my ( $num_headings_changed, %results );
482 "C4::Linker::" . ( C4::Context->preference("LinkerModule") || 'Default' );
483 eval { eval "require $linker_module"; };
485 $linker_module = 'C4::Linker::Default';
486 eval "require $linker_module";
492 my $linker = $linker_module->new(
493 { 'options' => C4::Context->preference("LinkerOptions") } );
494 my ( $headings_changed, undef ) =
495 LinkBibHeadingsToAuthorities( $linker, $record, $frameworkcode, C4::Context->preference("CatalogModuleRelink") || '' );
496 # By default we probably don't want to relink things when cataloging
497 return $headings_changed;
500 =head2 LinkBibHeadingsToAuthorities
502 my $num_headings_changed, %results = LinkBibHeadingsToAuthorities($linker, $marc, $frameworkcode, [$allowrelink]);
504 Links bib headings to authority records by checking
505 each authority-controlled field in the C<MARC::Record>
506 object C<$marc>, looking for a matching authority record,
507 and setting the linking subfield $9 to the ID of that
510 If $allowrelink is false, existing authids will never be
511 replaced, regardless of the values of LinkerKeepStale and
514 Returns the number of heading links changed in the
519 sub LinkBibHeadingsToAuthorities {
522 my $frameworkcode = shift;
523 my $allowrelink = shift;
526 require C4::AuthoritiesMarc;
528 $allowrelink = 1 unless defined $allowrelink;
529 my $num_headings_changed = 0;
530 foreach my $field ( $bib->fields() ) {
531 my $heading = C4::Heading->new_from_bib_field( $field, $frameworkcode );
532 next unless defined $heading;
535 my $current_link = $field->subfield('9');
537 if ( defined $current_link && (!$allowrelink || !C4::Context->preference('LinkerRelink')) )
539 $results{'linked'}->{ $heading->display_form() }++;
543 my ( $authid, $fuzzy ) = $linker->get_link($heading);
545 $results{ $fuzzy ? 'fuzzy' : 'linked' }
546 ->{ $heading->display_form() }++;
547 next if defined $current_link and $current_link == $authid;
549 $field->delete_subfield( code => '9' ) if defined $current_link;
550 $field->add_subfields( '9', $authid );
551 $num_headings_changed++;
554 if ( defined $current_link
555 && (!$allowrelink || C4::Context->preference('LinkerKeepStale')) )
557 $results{'fuzzy'}->{ $heading->display_form() }++;
559 elsif ( C4::Context->preference('AutoCreateAuthorities') ) {
561 C4::AuthoritiesMarc::GetAuthType( $heading->auth_type() );
562 my $marcrecordauth = MARC::Record->new();
563 if ( C4::Context->preference('marcflavour') eq 'MARC21' ) {
564 $marcrecordauth->leader(' nz a22 o 4500');
565 SetMarcUnicodeFlag( $marcrecordauth, 'MARC21' );
568 MARC::Field->new( $authtypedata->{auth_tag_to_report},
569 '', '', "a" => "" . $field->subfield('a') );
571 $authfield->add_subfields( $_->[0] => $_->[1] )
572 if ( $_->[0] =~ /[A-z]/ && $_->[0] ne "a" )
573 } $field->subfields();
574 $marcrecordauth->insert_fields_ordered($authfield);
576 # bug 2317: ensure new authority knows it's using UTF-8; currently
577 # only need to do this for MARC21, as MARC::Record->as_xml_record() handles
578 # automatically for UNIMARC (by not transcoding)
579 # FIXME: AddAuthority() instead should simply explicitly require that the MARC::Record
580 # use UTF-8, but as of 2008-08-05, did not want to introduce that kind
581 # of change to a core API just before the 3.0 release.
583 if ( C4::Context->preference('marcflavour') eq 'MARC21' ) {
584 $marcrecordauth->insert_fields_ordered(
587 'a' => "Machine generated authority record."
591 $bib->author() . ", "
592 . $bib->title_proper() . ", "
593 . $bib->publication_date() . " ";
594 $cite =~ s/^[\s\,]*//;
595 $cite =~ s/[\s\,]*$//;
598 . C4::Context->preference('MARCOrgCode') . ")"
599 . $bib->subfield( '999', 'c' ) . ": "
601 $marcrecordauth->insert_fields_ordered(
602 MARC::Field->new( '670', '', '', 'a' => $cite ) );
605 # warn "AUTH RECORD ADDED : ".$marcrecordauth->as_formatted;
608 C4::AuthoritiesMarc::AddAuthority( $marcrecordauth, '',
609 $heading->auth_type() );
610 $field->add_subfields( '9', $authid );
611 $num_headings_changed++;
612 $results{'added'}->{ $heading->display_form() }++;
614 elsif ( defined $current_link ) {
615 $field->delete_subfield( code => '9' );
616 $num_headings_changed++;
617 $results{'unlinked'}->{ $heading->display_form() }++;
620 $results{'unlinked'}->{ $heading->display_form() }++;
625 return $num_headings_changed, \%results;
628 =head2 GetRecordValue
630 my $values = GetRecordValue($field, $record, $frameworkcode);
632 Get MARC fields from a keyword defined in fieldmapping table.
637 my ( $field, $record, $frameworkcode ) = @_;
638 my $dbh = C4::Context->dbh;
640 my $sth = $dbh->prepare('SELECT fieldcode, subfieldcode FROM fieldmapping WHERE frameworkcode = ? AND field = ?');
641 $sth->execute( $frameworkcode, $field );
645 while ( my $row = $sth->fetchrow_hashref ) {
646 foreach my $field ( $record->field( $row->{fieldcode} ) ) {
647 if ( ( $row->{subfieldcode} ne "" && $field->subfield( $row->{subfieldcode} ) ) ) {
648 foreach my $subfield ( $field->subfield( $row->{subfieldcode} ) ) {
649 push @result, { 'subfield' => $subfield };
652 } elsif ( $row->{subfieldcode} eq "" ) {
653 push @result, { 'subfield' => $field->as_string() };
661 =head2 SetFieldMapping
663 SetFieldMapping($framework, $field, $fieldcode, $subfieldcode);
665 Set a Field to MARC mapping value, if it already exists we don't add a new one.
669 sub SetFieldMapping {
670 my ( $framework, $field, $fieldcode, $subfieldcode ) = @_;
671 my $dbh = C4::Context->dbh;
673 my $sth = $dbh->prepare('SELECT * FROM fieldmapping WHERE fieldcode = ? AND subfieldcode = ? AND frameworkcode = ? AND field = ?');
674 $sth->execute( $fieldcode, $subfieldcode, $framework, $field );
675 if ( not $sth->fetchrow_hashref ) {
677 $sth = $dbh->prepare('INSERT INTO fieldmapping (fieldcode, subfieldcode, frameworkcode, field) VALUES(?,?,?,?)');
679 $sth->execute( $fieldcode, $subfieldcode, $framework, $field );
683 =head2 DeleteFieldMapping
685 DeleteFieldMapping($id);
687 Delete a field mapping from an $id.
691 sub DeleteFieldMapping {
693 my $dbh = C4::Context->dbh;
695 my $sth = $dbh->prepare('DELETE FROM fieldmapping WHERE id = ?');
699 =head2 GetFieldMapping
701 GetFieldMapping($frameworkcode);
703 Get all field mappings for a specified frameworkcode
707 sub GetFieldMapping {
708 my ($framework) = @_;
709 my $dbh = C4::Context->dbh;
711 my $sth = $dbh->prepare('SELECT * FROM fieldmapping where frameworkcode = ?');
712 $sth->execute($framework);
715 while ( my $row = $sth->fetchrow_hashref ) {
723 $data = &GetBiblioData($biblionumber);
725 Returns information about the book with the given biblionumber.
726 C<&GetBiblioData> returns a reference-to-hash. The keys are the fields in
727 the C<biblio> and C<biblioitems> tables in the
730 In addition, C<$data-E<gt>{subject}> is the list of the book's
731 subjects, separated by C<" , "> (space, comma, space).
732 If there are multiple biblioitems with the given biblionumber, only
733 the first one is considered.
739 my $dbh = C4::Context->dbh;
741 # my $query = C4::Context->preference('item-level_itypes') ?
742 # " SELECT * , biblioitems.notes AS bnotes, biblio.notes
744 # LEFT JOIN biblioitems ON biblio.biblionumber = biblioitems.biblionumber
745 # WHERE biblio.biblionumber = ?
746 # AND biblioitems.biblionumber = biblio.biblionumber
749 my $query = " SELECT * , biblioitems.notes AS bnotes, itemtypes.notforloan as bi_notforloan, biblio.notes
751 LEFT JOIN biblioitems ON biblio.biblionumber = biblioitems.biblionumber
752 LEFT JOIN itemtypes ON biblioitems.itemtype = itemtypes.itemtype
753 WHERE biblio.biblionumber = ?
754 AND biblioitems.biblionumber = biblio.biblionumber ";
756 my $sth = $dbh->prepare($query);
757 $sth->execute($bibnum);
759 $data = $sth->fetchrow_hashref;
763 } # sub GetBiblioData
765 =head2 &GetBiblioItemData
767 $itemdata = &GetBiblioItemData($biblioitemnumber);
769 Looks up the biblioitem with the given biblioitemnumber. Returns a
770 reference-to-hash. The keys are the fields from the C<biblio>,
771 C<biblioitems>, and C<itemtypes> tables in the Koha database, except
772 that C<biblioitems.notes> is given as C<$itemdata-E<gt>{bnotes}>.
777 sub GetBiblioItemData {
778 my ($biblioitemnumber) = @_;
779 my $dbh = C4::Context->dbh;
780 my $query = "SELECT *,biblioitems.notes AS bnotes
781 FROM biblio LEFT JOIN biblioitems on biblio.biblionumber=biblioitems.biblionumber ";
782 unless ( C4::Context->preference('item-level_itypes') ) {
783 $query .= "LEFT JOIN itemtypes on biblioitems.itemtype=itemtypes.itemtype ";
785 $query .= " WHERE biblioitemnumber = ? ";
786 my $sth = $dbh->prepare($query);
788 $sth->execute($biblioitemnumber);
789 $data = $sth->fetchrow_hashref;
792 } # sub &GetBiblioItemData
794 =head2 GetBiblioItemByBiblioNumber
796 NOTE : This function has been copy/paste from C4/Biblio.pm from head before zebra integration.
800 sub GetBiblioItemByBiblioNumber {
801 my ($biblionumber) = @_;
802 my $dbh = C4::Context->dbh;
803 my $sth = $dbh->prepare("Select * FROM biblioitems WHERE biblionumber = ?");
807 $sth->execute($biblionumber);
809 while ( my $data = $sth->fetchrow_hashref ) {
810 push @results, $data;
817 =head2 GetBiblionumberFromItemnumber
822 sub GetBiblionumberFromItemnumber {
823 my ($itemnumber) = @_;
824 my $dbh = C4::Context->dbh;
825 my $sth = $dbh->prepare("Select biblionumber FROM items WHERE itemnumber = ?");
827 $sth->execute($itemnumber);
828 my ($result) = $sth->fetchrow;
832 =head2 GetBiblioFromItemNumber
834 $item = &GetBiblioFromItemNumber($itemnumber,$barcode);
836 Looks up the item with the given itemnumber. if undef, try the barcode.
838 C<&itemnodata> returns a reference-to-hash whose keys are the fields
839 from the C<biblio>, C<biblioitems>, and C<items> tables in the Koha
845 sub GetBiblioFromItemNumber {
846 my ( $itemnumber, $barcode ) = @_;
847 my $dbh = C4::Context->dbh;
850 $sth = $dbh->prepare(
852 LEFT JOIN biblio ON biblio.biblionumber = items.biblionumber
853 LEFT JOIN biblioitems ON biblioitems.biblioitemnumber = items.biblioitemnumber
854 WHERE items.itemnumber = ?"
856 $sth->execute($itemnumber);
858 $sth = $dbh->prepare(
860 LEFT JOIN biblio ON biblio.biblionumber = items.biblionumber
861 LEFT JOIN biblioitems ON biblioitems.biblioitemnumber = items.biblioitemnumber
862 WHERE items.barcode = ?"
864 $sth->execute($barcode);
866 my $data = $sth->fetchrow_hashref;
873 $isbd = &GetISBDView($biblionumber);
875 Return the ISBD view which can be included in opac and intranet
880 my ( $biblionumber, $template ) = @_;
881 my $record = GetMarcBiblio($biblionumber, 1);
882 return undef unless defined $record;
883 my $itemtype = &GetFrameworkCode($biblionumber);
884 my ( $holdingbrtagf, $holdingbrtagsubf ) = &GetMarcFromKohaField( "items.holdingbranch", $itemtype );
885 my $tagslib = &GetMarcStructure( 1, $itemtype );
887 my $ISBD = C4::Context->preference('isbd');
892 foreach my $isbdfield ( split( /#/, $bloc ) ) {
894 # $isbdfield= /(.?.?.?)/;
895 $isbdfield =~ /(\d\d\d)([^\|])?\|(.*)\|(.*)\|(.*)/;
896 my $fieldvalue = $1 || 0;
897 my $subfvalue = $2 || "";
899 my $analysestring = $4;
902 # warn "==> $1 / $2 / $3 / $4";
903 # my $fieldvalue=substr($isbdfield,0,3);
904 if ( $fieldvalue > 0 ) {
905 my $hasputtextbefore = 0;
906 my @fieldslist = $record->field($fieldvalue);
907 @fieldslist = sort { $a->subfield($holdingbrtagsubf) cmp $b->subfield($holdingbrtagsubf) } @fieldslist if ( $fieldvalue eq $holdingbrtagf );
909 # warn "ERROR IN ISBD DEFINITION at : $isbdfield" unless $fieldvalue;
910 # warn "FV : $fieldvalue";
911 if ( $subfvalue ne "" ) {
912 foreach my $field (@fieldslist) {
913 foreach my $subfield ( $field->subfield($subfvalue) ) {
914 my $calculated = $analysestring;
915 my $tag = $field->tag();
918 my $subfieldvalue = GetAuthorisedValueDesc( $tag, $subfvalue, $subfield, '', $tagslib );
919 my $tagsubf = $tag . $subfvalue;
920 $calculated =~ s/\{(.?.?.?.?)$tagsubf(.*?)\}/$1$subfieldvalue$2\{$1$tagsubf$2\}/g;
921 if ( $template eq "opac" ) { $calculated =~ s#/cgi-bin/koha/[^/]+/([^.]*.pl\?.*)$#opac-$1#g; }
923 # field builded, store the result
924 if ( $calculated && !$hasputtextbefore ) { # put textbefore if not done
925 $blocres .= $textbefore;
926 $hasputtextbefore = 1;
929 # remove punctuation at start
930 $calculated =~ s/^( |;|:|\.|-)*//g;
931 $blocres .= $calculated;
936 $blocres .= $textafter if $hasputtextbefore;
938 foreach my $field (@fieldslist) {
939 my $calculated = $analysestring;
940 my $tag = $field->tag();
943 my @subf = $field->subfields;
944 for my $i ( 0 .. $#subf ) {
945 my $valuecode = $subf[$i][1];
946 my $subfieldcode = $subf[$i][0];
947 my $subfieldvalue = GetAuthorisedValueDesc( $tag, $subf[$i][0], $subf[$i][1], '', $tagslib );
948 my $tagsubf = $tag . $subfieldcode;
950 $calculated =~ s/ # replace all {{}} codes by the value code.
951 \{\{$tagsubf\}\} # catch the {{actualcode}}
953 $valuecode # replace by the value code
956 $calculated =~ s/\{(.?.?.?.?)$tagsubf(.*?)\}/$1$subfieldvalue$2\{$1$tagsubf$2\}/g;
957 if ( $template eq "opac" ) { $calculated =~ s#/cgi-bin/koha/[^/]+/([^.]*.pl\?.*)$#opac-$1#g; }
960 # field builded, store the result
961 if ( $calculated && !$hasputtextbefore ) { # put textbefore if not done
962 $blocres .= $textbefore;
963 $hasputtextbefore = 1;
966 # remove punctuation at start
967 $calculated =~ s/^( |;|:|\.|-)*//g;
968 $blocres .= $calculated;
971 $blocres .= $textafter if $hasputtextbefore;
974 $blocres .= $isbdfield;
979 $res =~ s/\{(.*?)\}//g;
981 $res =~ s/\n/<br\/>/g;
991 ( $count, @results ) = &GetBiblio($biblionumber);
996 my ($biblionumber) = @_;
997 my $dbh = C4::Context->dbh;
998 my $sth = $dbh->prepare("SELECT * FROM biblio WHERE biblionumber = ?");
1001 $sth->execute($biblionumber);
1002 while ( my $data = $sth->fetchrow_hashref ) {
1003 $results[$count] = $data;
1007 return ( $count, @results );
1010 =head2 GetBiblioItemInfosOf
1012 GetBiblioItemInfosOf(@biblioitemnumbers);
1016 sub GetBiblioItemInfosOf {
1017 my @biblioitemnumbers = @_;
1020 SELECT biblioitemnumber,
1024 WHERE biblioitemnumber IN (' . join( ',', @biblioitemnumbers ) . ')
1026 return get_infos_of( $query, 'biblioitemnumber' );
1029 =head1 FUNCTIONS FOR HANDLING MARC MANAGEMENT
1031 =head2 GetMarcStructure
1033 $res = GetMarcStructure($forlibrarian,$frameworkcode);
1035 Returns a reference to a big hash of hash, with the Marc structure for the given frameworkcode
1036 $forlibrarian :if set to 1, the MARC descriptions are the librarians ones, otherwise it's the public (OPAC) ones
1037 $frameworkcode : the framework code to read
1041 # cache for results of GetMarcStructure -- needed
1043 our $marc_structure_cache;
1045 sub GetMarcStructure {
1046 my ( $forlibrarian, $frameworkcode ) = @_;
1047 my $dbh = C4::Context->dbh;
1048 $frameworkcode = "" unless $frameworkcode;
1050 if ( defined $marc_structure_cache and exists $marc_structure_cache->{$forlibrarian}->{$frameworkcode} ) {
1051 return $marc_structure_cache->{$forlibrarian}->{$frameworkcode};
1054 # my $sth = $dbh->prepare(
1055 # "SELECT COUNT(*) FROM marc_tag_structure WHERE frameworkcode=?");
1056 # $sth->execute($frameworkcode);
1057 # my ($total) = $sth->fetchrow;
1058 # $frameworkcode = "" unless ( $total > 0 );
1059 my $sth = $dbh->prepare(
1060 "SELECT tagfield,liblibrarian,libopac,mandatory,repeatable
1061 FROM marc_tag_structure
1062 WHERE frameworkcode=?
1065 $sth->execute($frameworkcode);
1066 my ( $liblibrarian, $libopac, $tag, $res, $tab, $mandatory, $repeatable );
1068 while ( ( $tag, $liblibrarian, $libopac, $mandatory, $repeatable ) = $sth->fetchrow ) {
1069 $res->{$tag}->{lib} = ( $forlibrarian or !$libopac ) ? $liblibrarian : $libopac;
1070 $res->{$tag}->{tab} = "";
1071 $res->{$tag}->{mandatory} = $mandatory;
1072 $res->{$tag}->{repeatable} = $repeatable;
1075 $sth = $dbh->prepare(
1076 "SELECT tagfield,tagsubfield,liblibrarian,libopac,tab,mandatory,repeatable,authorised_value,authtypecode,value_builder,kohafield,seealso,hidden,isurl,link,defaultvalue
1077 FROM marc_subfield_structure
1078 WHERE frameworkcode=?
1079 ORDER BY tagfield,tagsubfield
1083 $sth->execute($frameworkcode);
1086 my $authorised_value;
1097 ( $tag, $subfield, $liblibrarian, $libopac, $tab, $mandatory, $repeatable, $authorised_value,
1098 $authtypecode, $value_builder, $kohafield, $seealso, $hidden, $isurl, $link, $defaultvalue
1102 $res->{$tag}->{$subfield}->{lib} = ( $forlibrarian or !$libopac ) ? $liblibrarian : $libopac;
1103 $res->{$tag}->{$subfield}->{tab} = $tab;
1104 $res->{$tag}->{$subfield}->{mandatory} = $mandatory;
1105 $res->{$tag}->{$subfield}->{repeatable} = $repeatable;
1106 $res->{$tag}->{$subfield}->{authorised_value} = $authorised_value;
1107 $res->{$tag}->{$subfield}->{authtypecode} = $authtypecode;
1108 $res->{$tag}->{$subfield}->{value_builder} = $value_builder;
1109 $res->{$tag}->{$subfield}->{kohafield} = $kohafield;
1110 $res->{$tag}->{$subfield}->{seealso} = $seealso;
1111 $res->{$tag}->{$subfield}->{hidden} = $hidden;
1112 $res->{$tag}->{$subfield}->{isurl} = $isurl;
1113 $res->{$tag}->{$subfield}->{'link'} = $link;
1114 $res->{$tag}->{$subfield}->{defaultvalue} = $defaultvalue;
1117 $marc_structure_cache->{$forlibrarian}->{$frameworkcode} = $res;
1122 =head2 GetUsedMarcStructure
1124 The same function as GetMarcStructure except it just takes field
1125 in tab 0-9. (used field)
1127 my $results = GetUsedMarcStructure($frameworkcode);
1129 C<$results> is a ref to an array which each case containts a ref
1130 to a hash which each keys is the columns from marc_subfield_structure
1132 C<$frameworkcode> is the framework code.
1136 sub GetUsedMarcStructure($) {
1137 my $frameworkcode = shift || '';
1140 FROM marc_subfield_structure
1142 AND frameworkcode = ?
1143 ORDER BY tagfield, tagsubfield
1145 my $sth = C4::Context->dbh->prepare($query);
1146 $sth->execute($frameworkcode);
1147 return $sth->fetchall_arrayref( {} );
1150 =head2 GetMarcFromKohaField
1152 ($MARCfield,$MARCsubfield)=GetMarcFromKohaField($kohafield,$frameworkcode);
1154 Returns the MARC fields & subfields mapped to the koha field
1155 for the given frameworkcode
1159 sub GetMarcFromKohaField {
1160 my ( $kohafield, $frameworkcode ) = @_;
1161 return (0, undef) unless $kohafield and defined $frameworkcode;
1162 my $relations = C4::Context->marcfromkohafield;
1163 if ( my $mf = $relations->{$frameworkcode}->{$kohafield} ) {
1169 =head2 GetMarcBiblio
1171 my $record = GetMarcBiblio($biblionumber, [$embeditems]);
1173 Returns MARC::Record representing bib identified by
1174 C<$biblionumber>. If no bib exists, returns undef.
1175 C<$embeditems>. If set to true, items data are included.
1176 The MARC record contains biblio data, and items data if $embeditems is set to true.
1181 my $biblionumber = shift;
1182 my $embeditems = shift || 0;
1183 my $dbh = C4::Context->dbh;
1184 my $sth = $dbh->prepare("SELECT marcxml FROM biblioitems WHERE biblionumber=? ");
1185 $sth->execute($biblionumber);
1186 my $row = $sth->fetchrow_hashref;
1187 my $marcxml = StripNonXmlChars( $row->{'marcxml'} );
1188 MARC::File::XML->default_record_format( C4::Context->preference('marcflavour') );
1189 my $record = MARC::Record->new();
1192 $record = eval { MARC::Record::new_from_xml( $marcxml, "utf8", C4::Context->preference('marcflavour') ) };
1193 if ($@) { warn " problem with :$biblionumber : $@ \n$marcxml"; }
1194 return unless $record;
1196 C4::Biblio::_koha_marc_update_bib_ids($record, '', $biblionumber, $biblionumber);
1197 C4::Biblio::EmbedItemsInMarcBiblio($record, $biblionumber) if ($embeditems);
1207 my $marcxml = GetXmlBiblio($biblionumber);
1209 Returns biblioitems.marcxml of the biblionumber passed in parameter.
1210 The XML contains both biblio & item datas
1215 my ($biblionumber) = @_;
1216 my $dbh = C4::Context->dbh;
1217 my $sth = $dbh->prepare("SELECT marcxml FROM biblioitems WHERE biblionumber=? ");
1218 $sth->execute($biblionumber);
1219 my ($marcxml) = $sth->fetchrow;
1223 =head2 GetCOinSBiblio
1225 my $coins = GetCOinSBiblio($record);
1227 Returns the COinS (a span) which can be included in a biblio record
1231 sub GetCOinSBiblio {
1234 # get the coin format
1238 my $pos7 = substr $record->leader(), 7, 1;
1239 my $pos6 = substr $record->leader(), 6, 1;
1242 my ( $aulast, $aufirst ) = ( '', '' );
1251 my $titletype = 'b';
1253 # For the purposes of generating COinS metadata, LDR/06-07 can be
1254 # considered the same for UNIMARC and MARC21
1259 'b' => 'manuscript',
1261 'd' => 'manuscript',
1265 'i' => 'audioRecording',
1266 'j' => 'audioRecording',
1269 'm' => 'computerProgram',
1274 'a' => 'journalArticle',
1278 $genre = $fmts6->{$pos6} ? $fmts6->{$pos6} : 'book';
1280 if ( $genre eq 'book' ) {
1281 $genre = $fmts7->{$pos7} if $fmts7->{$pos7};
1284 ##### We must transform mtx to a valable mtx and document type ####
1285 if ( $genre eq 'book' ) {
1287 } elsif ( $genre eq 'journal' ) {
1290 } elsif ( $genre eq 'journalArticle' ) {
1298 $genre = ( $mtx eq 'dc' ) ? "&rft.type=$genre" : "&rft.genre=$genre";
1300 if ( C4::Context->preference("marcflavour") eq "UNIMARC" ) {
1303 $aulast = $record->subfield( '700', 'a' ) || '';
1304 $aufirst = $record->subfield( '700', 'b' ) || '';
1305 $oauthors = "&rft.au=$aufirst $aulast";
1308 if ( $record->field('200') ) {
1309 for my $au ( $record->field('200')->subfield('g') ) {
1310 $oauthors .= "&rft.au=$au";
1315 ? "&rft.title=" . $record->subfield( '200', 'a' )
1316 : "&rft.title=" . $record->subfield( '200', 'a' ) . "&rft.btitle=" . $record->subfield( '200', 'a' );
1317 $pubyear = $record->subfield( '210', 'd' ) || '';
1318 $publisher = $record->subfield( '210', 'c' ) || '';
1319 $isbn = $record->subfield( '010', 'a' ) || '';
1320 $issn = $record->subfield( '011', 'a' ) || '';
1323 # MARC21 need some improve
1326 if ( $record->field('100') ) {
1327 $oauthors .= "&rft.au=" . $record->subfield( '100', 'a' );
1331 if ( $record->field('700') ) {
1332 for my $au ( $record->field('700')->subfield('a') ) {
1333 $oauthors .= "&rft.au=$au";
1336 $title = "&rft." . $titletype . "title=" . $record->subfield( '245', 'a' );
1337 $subtitle = $record->subfield( '245', 'b' ) || '';
1338 $title .= $subtitle;
1339 if ($titletype eq 'a') {
1340 $pubyear = $record->field('008') || '';
1341 $pubyear = substr($pubyear->data(), 7, 4) if $pubyear;
1342 $isbn = $record->subfield( '773', 'z' ) || '';
1343 $issn = $record->subfield( '773', 'x' ) || '';
1344 if ($mtx eq 'journal') {
1345 $title .= "&rft.title=" . (($record->subfield( '773', 't' ) || $record->subfield( '773', 'a')));
1347 $title .= "&rft.btitle=" . (($record->subfield( '773', 't' ) || $record->subfield( '773', 'a')) || '');
1349 foreach my $rel ($record->subfield( '773', 'g' )) {
1356 $pubyear = $record->subfield( '260', 'c' ) || '';
1357 $publisher = $record->subfield( '260', 'b' ) || '';
1358 $isbn = $record->subfield( '020', 'a' ) || '';
1359 $issn = $record->subfield( '022', 'a' ) || '';
1364 "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";
1365 $coins_value =~ s/(\ |&[^a])/\+/g;
1366 $coins_value =~ s/\"/\"\;/g;
1368 #<!-- 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="
1370 return $coins_value;
1376 return the prices in accordance with the Marc format.
1380 my ( $record, $marcflavour ) = @_;
1384 if ( $marcflavour eq "MARC21" ) {
1385 @listtags = ('345', '020');
1387 } elsif ( $marcflavour eq "UNIMARC" ) {
1388 @listtags = ('345', '010');
1394 for my $field ( $record->field(@listtags) ) {
1395 for my $subfield_value ($field->subfield($subfield)){
1397 return $subfield_value if ($subfield_value);
1400 return 0; # no price found
1403 =head2 GetMarcQuantity
1405 return the quantity of a book. Used in acquisition only, when importing a file an iso2709 from a bookseller
1406 Warning : this is not really in the marc standard. In Unimarc, Electre (the most widely used bookseller) use the 969$a
1410 sub GetMarcQuantity {
1411 my ( $record, $marcflavour ) = @_;
1415 if ( $marcflavour eq "MARC21" ) {
1417 } elsif ( $marcflavour eq "UNIMARC" ) {
1418 @listtags = ('969');
1424 for my $field ( $record->field(@listtags) ) {
1425 for my $subfield_value ($field->subfield($subfield)){
1427 if ($subfield_value) {
1428 # in France, the cents separator is the , but sometimes, ppl use a .
1429 # in this case, the price will be x100 when unformatted ! Replace the . by a , to get a proper price calculation
1430 $subfield_value =~ s/\./,/ if C4::Context->preference("CurrencyFormat") eq "FR";
1431 return $subfield_value;
1435 return 0; # no price found
1439 =head2 GetAuthorisedValueDesc
1441 my $subfieldvalue =get_authorised_value_desc(
1442 $tag, $subf[$i][0],$subf[$i][1], '', $taglib, $category, $opac);
1444 Retrieve the complete description for a given authorised value.
1446 Now takes $category and $value pair too.
1448 my $auth_value_desc =GetAuthorisedValueDesc(
1449 '','', 'DVD' ,'','','CCODE');
1451 If the optional $opac parameter is set to a true value, displays OPAC
1452 descriptions rather than normal ones when they exist.
1456 sub GetAuthorisedValueDesc {
1457 my ( $tag, $subfield, $value, $framework, $tagslib, $category, $opac ) = @_;
1458 my $dbh = C4::Context->dbh;
1462 return $value unless defined $tagslib->{$tag}->{$subfield}->{'authorised_value'};
1465 if ( $tagslib->{$tag}->{$subfield}->{'authorised_value'} eq "branches" ) {
1466 return C4::Branch::GetBranchName($value);
1470 if ( $tagslib->{$tag}->{$subfield}->{'authorised_value'} eq "itemtypes" ) {
1471 return getitemtypeinfo($value)->{description};
1474 #---- "true" authorized value
1475 $category = $tagslib->{$tag}->{$subfield}->{'authorised_value'};
1478 if ( $category ne "" ) {
1479 my $sth = $dbh->prepare( "SELECT lib, lib_opac FROM authorised_values WHERE category = ? AND authorised_value = ?" );
1480 $sth->execute( $category, $value );
1481 my $data = $sth->fetchrow_hashref;
1482 return ( $opac && $data->{'lib_opac'} ) ? $data->{'lib_opac'} : $data->{'lib'};
1484 return $value; # if nothing is found return the original value
1488 =head2 GetMarcControlnumber
1490 $marccontrolnumber = GetMarcControlnumber($record,$marcflavour);
1492 Get the control number / record Identifier from the MARC record and return it.
1496 sub GetMarcControlnumber {
1497 my ( $record, $marcflavour ) = @_;
1498 my $controlnumber = "";
1499 # Control number or Record identifier are the same field in MARC21, UNIMARC and NORMARC
1500 # Keep $marcflavour for possible later use
1501 if ($marcflavour eq "MARC21" || $marcflavour eq "UNIMARC" || $marcflavour eq "NORMARC") {
1502 my $controlnumberField = $record->field('001');
1503 if ($controlnumberField) {
1504 $controlnumber = $controlnumberField->data();
1507 return $controlnumber;
1512 $marcisbnsarray = GetMarcISBN( $record, $marcflavour );
1514 Get all ISBNs from the MARC record and returns them in an array.
1515 ISBNs stored in different fields depending on MARC flavour
1520 my ( $record, $marcflavour ) = @_;
1522 if ( $marcflavour eq "UNIMARC" ) {
1524 } else { # assume marc21 if not unimarc
1531 foreach my $field ( $record->field($scope) ) {
1532 my $value = $field->as_string();
1533 if ( $isbn ne "" ) {
1534 $marcisbn = { marcisbn => $isbn, };
1535 push @marcisbns, $marcisbn;
1538 if ( $isbn ne $value ) {
1539 $isbn = $isbn . " " . $value;
1544 $marcisbn = { marcisbn => $isbn };
1545 push @marcisbns, $marcisbn; #load last tag into array
1553 $marcissnsarray = GetMarcISSN( $record, $marcflavour );
1555 Get all valid ISSNs from the MARC record and returns them in an array.
1556 ISSNs are stored in different fields depending on MARC flavour
1561 my ( $record, $marcflavour ) = @_;
1563 if ( $marcflavour eq "UNIMARC" ) {
1566 else { # assume MARC21 or NORMARC
1570 foreach my $field ( $record->field($scope) ) {
1571 push @marcissns, $field->subfield( 'a' );
1578 $marcnotesarray = GetMarcNotes( $record, $marcflavour );
1580 Get all notes from the MARC record and returns them in an array.
1581 The note are stored in different fields depending on MARC flavour
1586 my ( $record, $marcflavour ) = @_;
1588 if ( $marcflavour eq "UNIMARC" ) {
1590 } else { # assume marc21 if not unimarc
1597 foreach my $field ( $record->field($scope) ) {
1598 my $value = $field->as_string();
1599 if ( $note ne "" ) {
1600 $marcnote = { marcnote => $note, };
1601 push @marcnotes, $marcnote;
1604 if ( $note ne $value ) {
1605 $note = $note . " " . $value;
1610 $marcnote = { marcnote => $note };
1611 push @marcnotes, $marcnote; #load last tag into array
1614 } # end GetMarcNotes
1616 =head2 GetMarcSubjects
1618 $marcsubjcts = GetMarcSubjects($record,$marcflavour);
1620 Get all subjects from the MARC record and returns them in an array.
1621 The subjects are stored in different fields depending on MARC flavour
1625 sub GetMarcSubjects {
1626 my ( $record, $marcflavour ) = @_;
1627 my ( $mintag, $maxtag );
1628 if ( $marcflavour eq "UNIMARC" ) {
1631 } else { # assume marc21 if not unimarc
1641 my $subject_limit = C4::Context->preference("TraceCompleteSubfields") ? 'su,complete-subfield' : 'su';
1643 foreach my $field ( $record->field('6..') ) {
1644 next unless $field->tag() >= $mintag && $field->tag() <= $maxtag;
1646 my @subfields = $field->subfields();
1650 # if there is an authority link, build the link with an= subfield9
1652 for my $subject_subfield (@subfields) {
1654 # don't load unimarc subfields 3,4,5
1655 next if ( ( $marcflavour eq "UNIMARC" ) and ( $subject_subfield->[0] =~ /2|3|4|5/ ) );
1657 # don't load MARC21 subfields 2 (FIXME: any more subfields??)
1658 next if ( ( $marcflavour eq "MARC21" ) and ( $subject_subfield->[0] =~ /2/ ) );
1659 my $code = $subject_subfield->[0];
1660 my $value = $subject_subfield->[1];
1661 my $linkvalue = $value;
1662 $linkvalue =~ s/(\(|\))//g;
1664 if ( $counter != 0 ) {
1665 $operator = ' and ';
1669 @link_loop = ( { 'limit' => 'an', link => "$linkvalue" } );
1671 if ( not $found9 ) {
1672 push @link_loop, { 'limit' => $subject_limit, link => $linkvalue, operator => $operator };
1675 if ( $counter != 0 ) {
1676 $separator = C4::Context->preference('authoritysep');
1680 my @this_link_loop = @link_loop;
1681 push @subfields_loop, { code => $code, value => $value, link_loop => \@this_link_loop, separator => $separator } unless ( $subject_subfield->[0] eq 9 );
1685 push @marcsubjects, { MARCSUBJECT_SUBFIELDS_LOOP => \@subfields_loop };
1688 return \@marcsubjects;
1689 } #end getMARCsubjects
1691 =head2 GetMarcAuthors
1693 authors = GetMarcAuthors($record,$marcflavour);
1695 Get all authors from the MARC record and returns them in an array.
1696 The authors are stored in different fields depending on MARC flavour
1700 sub GetMarcAuthors {
1701 my ( $record, $marcflavour ) = @_;
1702 my ( $mintag, $maxtag );
1704 # tagslib useful for UNIMARC author reponsabilities
1706 &GetMarcStructure( 1, '' ); # FIXME : we don't have the framework available, we take the default framework. May be buggy on some setups, will be usually correct.
1707 if ( $marcflavour eq "UNIMARC" ) {
1710 } elsif ( $marcflavour eq "MARC21" || $marcflavour eq "NORMARC" ) { # assume marc21 or normarc if not unimarc
1718 foreach my $field ( $record->fields ) {
1719 next unless $field->tag() >= $mintag && $field->tag() <= $maxtag;
1722 my @subfields = $field->subfields();
1725 # if there is an authority link, build the link with Koha-Auth-Number: subfield9
1726 my $subfield9 = $field->subfield('9');
1727 for my $authors_subfield (@subfields) {
1729 # don't load unimarc subfields 3, 5
1730 next if ( $marcflavour eq 'UNIMARC' and ( $authors_subfield->[0] =~ /3|5/ ) );
1731 my $subfieldcode = $authors_subfield->[0];
1732 my $value = $authors_subfield->[1];
1733 my $linkvalue = $value;
1734 $linkvalue =~ s/(\(|\))//g;
1736 if ( $count_auth != 0 ) {
1737 $operator = ' and ';
1740 # if we have an authority link, use that as the link, otherwise use standard searching
1742 @link_loop = ( { 'limit' => 'an', link => "$subfield9" } );
1745 # reset $linkvalue if UNIMARC author responsibility
1746 if ( $marcflavour eq 'UNIMARC' and ( $authors_subfield->[0] eq "4" ) ) {
1747 $linkvalue = "(" . GetAuthorisedValueDesc( $field->tag(), $authors_subfield->[0], $authors_subfield->[1], '', $tagslib ) . ")";
1749 push @link_loop, { 'limit' => 'au', link => $linkvalue, operator => $operator };
1751 $value = GetAuthorisedValueDesc( $field->tag(), $authors_subfield->[0], $authors_subfield->[1], '', $tagslib )
1752 if ( $marcflavour eq 'UNIMARC' and ( $authors_subfield->[0] =~ /4/ ) );
1753 my @this_link_loop = @link_loop;
1755 if ( $count_auth != 0 ) {
1756 $separator = C4::Context->preference('authoritysep');
1758 push @subfields_loop,
1759 { tag => $field->tag(),
1760 code => $subfieldcode,
1762 link_loop => \@this_link_loop,
1763 separator => $separator
1765 unless ( $authors_subfield->[0] eq '9' );
1768 push @marcauthors, { MARCAUTHOR_SUBFIELDS_LOOP => \@subfields_loop };
1770 return \@marcauthors;
1775 $marcurls = GetMarcUrls($record,$marcflavour);
1777 Returns arrayref of URLs from MARC data, suitable to pass to tmpl loop.
1778 Assumes web resources (not uncommon in MARC21 to omit resource type ind)
1783 my ( $record, $marcflavour ) = @_;
1786 for my $field ( $record->field('856') ) {
1788 for my $note ( $field->subfield('z') ) {
1789 push @notes, { note => $note };
1791 my @urls = $field->subfield('u');
1792 foreach my $url (@urls) {
1794 if ( $marcflavour eq 'MARC21' ) {
1795 my $s3 = $field->subfield('3');
1796 my $link = $field->subfield('y');
1797 unless ( $url =~ /^\w+:/ ) {
1798 if ( $field->indicator(1) eq '7' ) {
1799 $url = $field->subfield('2') . "://" . $url;
1800 } elsif ( $field->indicator(1) eq '1' ) {
1801 $url = 'ftp://' . $url;
1804 # properly, this should be if ind1=4,
1805 # however we will assume http protocol since we're building a link.
1806 $url = 'http://' . $url;
1810 # TODO handle ind 2 (relationship)
1815 $marcurl->{'linktext'} = $link || $s3 || C4::Context->preference('URLLinkText') || $url;
1816 $marcurl->{'part'} = $s3 if ($link);
1817 $marcurl->{'toc'} = 1 if ( defined($s3) && $s3 =~ /^[Tt]able/ );
1819 $marcurl->{'linktext'} = $field->subfield('2') || C4::Context->preference('URLLinkText') || $url;
1820 $marcurl->{'MARCURL'} = $url;
1822 push @marcurls, $marcurl;
1828 =head2 GetMarcSeries
1830 $marcseriesarray = GetMarcSeries($record,$marcflavour);
1832 Get all series from the MARC record and returns them in an array.
1833 The series are stored in different fields depending on MARC flavour
1838 my ( $record, $marcflavour ) = @_;
1839 my ( $mintag, $maxtag );
1840 if ( $marcflavour eq "UNIMARC" ) {
1843 } else { # assume marc21 if not unimarc
1853 foreach my $field ( $record->field('440'), $record->field('490') ) {
1856 #my $value = $field->subfield('a');
1857 #$marcsubjct = {MARCSUBJCT => $value,};
1858 my @subfields = $field->subfields();
1860 #warn "subfields:".join " ", @$subfields;
1863 for my $series_subfield (@subfields) {
1865 undef $volume_number;
1867 # see if this is an instance of a volume
1868 if ( $series_subfield->[0] eq 'v' ) {
1872 my $code = $series_subfield->[0];
1873 my $value = $series_subfield->[1];
1874 my $linkvalue = $value;
1875 $linkvalue =~ s/(\(|\))//g;
1876 if ( $counter != 0 ) {
1877 push @link_loop, { link => $linkvalue, operator => ' and ', };
1879 push @link_loop, { link => $linkvalue, operator => undef, };
1882 if ( $counter != 0 ) {
1883 $separator = C4::Context->preference('authoritysep');
1885 if ($volume_number) {
1886 push @subfields_loop, { volumenum => $value };
1888 if ( $series_subfield->[0] ne '9' ) {
1889 push @subfields_loop, {
1892 link_loop => \@link_loop,
1893 separator => $separator,
1894 volumenum => $volume_number,
1900 push @marcseries, { MARCSERIES_SUBFIELDS_LOOP => \@subfields_loop };
1902 #$marcsubjct = {MARCSUBJCT => $field->as_string(),};
1903 #push @marcsubjcts, $marcsubjct;
1907 my $marcseriessarray = \@marcseries;
1908 return $marcseriessarray;
1909 } #end getMARCseriess
1913 $marchostsarray = GetMarcHosts($record,$marcflavour);
1915 Get all host records (773s MARC21, 461 UNIMARC) from the MARC record and returns them in an array.
1920 my ( $record, $marcflavour ) = @_;
1921 my ( $tag,$title_subf,$bibnumber_subf,$itemnumber_subf);
1922 $marcflavour ||="MARC21";
1923 if ( $marcflavour eq "MARC21" || $marcflavour eq "NORMARC" ) {
1926 $bibnumber_subf ="0";
1927 $itemnumber_subf='9';
1929 elsif ($marcflavour eq "UNIMARC") {
1932 $bibnumber_subf ="0";
1933 $itemnumber_subf='9';
1938 foreach my $field ( $record->field($tag)) {
1942 my $hostbiblionumber = $field->subfield("$bibnumber_subf");
1943 my $hosttitle = $field->subfield($title_subf);
1944 my $hostitemnumber=$field->subfield($itemnumber_subf);
1945 push @fields_loop, { hostbiblionumber => $hostbiblionumber, hosttitle => $hosttitle, hostitemnumber => $hostitemnumber};
1946 push @marchosts, { MARCHOSTS_FIELDS_LOOP => \@fields_loop };
1949 my $marchostsarray = \@marchosts;
1950 return $marchostsarray;
1953 =head2 GetFrameworkCode
1955 $frameworkcode = GetFrameworkCode( $biblionumber )
1959 sub GetFrameworkCode {
1960 my ($biblionumber) = @_;
1961 my $dbh = C4::Context->dbh;
1962 my $sth = $dbh->prepare("SELECT frameworkcode FROM biblio WHERE biblionumber=?");
1963 $sth->execute($biblionumber);
1964 my ($frameworkcode) = $sth->fetchrow;
1965 return $frameworkcode;
1968 =head2 TransformKohaToMarc
1970 $record = TransformKohaToMarc( $hash )
1972 This function builds partial MARC::Record from a hash
1973 Hash entries can be from biblio or biblioitems.
1975 This function is called in acquisition module, to create a basic catalogue
1976 entry from user entry
1981 sub TransformKohaToMarc {
1983 my $record = MARC::Record->new();
1984 SetMarcUnicodeFlag( $record, C4::Context->preference("marcflavour") );
1985 my $db_to_marc = C4::Context->marcfromkohafield;
1986 while ( my ($name, $value) = each %$hash ) {
1987 next unless my $dtm = $db_to_marc->{''}->{$name};
1988 my ($tag, $letter) = @$dtm;
1989 foreach my $value ( split(/\s?\|\s?/, $value, -1) ) {
1990 if ( my $field = $record->field($tag) ) {
1991 $field->add_subfields( $letter => $value );
1994 $record->insert_fields_ordered( MARC::Field->new(
1995 $tag, " ", " ", $letter => $value ) );
2003 =head2 PrepHostMarcField
2005 $hostfield = PrepHostMarcField ( $hostbiblionumber,$hostitemnumber,$marcflavour )
2007 This function returns a host field populated with data from the host record, the field can then be added to an analytical record
2011 sub PrepHostMarcField {
2012 my ($hostbiblionumber,$hostitemnumber, $marcflavour) = @_;
2013 $marcflavour ||="MARC21";
2016 my $hostrecord = GetMarcBiblio($hostbiblionumber);
2017 my $item = C4::Items::GetItem($hostitemnumber);
2020 if ( $marcflavour eq "MARC21" || $marcflavour eq "NORMARC" ) {
2024 if ($hostrecord->subfield('100','a')){
2025 $mainentry = $hostrecord->subfield('100','a');
2026 } elsif ($hostrecord->subfield('110','a')){
2027 $mainentry = $hostrecord->subfield('110','a');
2029 $mainentry = $hostrecord->subfield('111','a');
2032 # qualification info
2034 if (my $field260 = $hostrecord->field('260')){
2035 $qualinfo = $field260->as_string( 'abc' );
2040 my $ed = $hostrecord->subfield('250','a');
2041 my $barcode = $item->{'barcode'};
2042 my $title = $hostrecord->subfield('245','a');
2044 # record control number, 001 with 003 and prefix
2046 if ($hostrecord->field('001')){
2047 $recctrlno = $hostrecord->field('001')->data();
2048 if ($hostrecord->field('003')){
2049 $recctrlno = '('.$hostrecord->field('003')->data().')'.$recctrlno;
2054 my $issn = $hostrecord->subfield('022','a');
2055 my $isbn = $hostrecord->subfield('020','a');
2058 $hostmarcfield = MARC::Field->new(
2060 '0' => $hostbiblionumber,
2061 '9' => $hostitemnumber,
2071 } elsif ($marcflavour eq "UNIMARC") {
2072 $hostmarcfield = MARC::Field->new(
2074 '0' => $hostbiblionumber,
2075 't' => $hostrecord->subfield('200','a'),
2076 '9' => $hostitemnumber
2080 return $hostmarcfield;
2083 =head2 TransformHtmlToXml
2085 $xml = TransformHtmlToXml( $tags, $subfields, $values, $indicator,
2086 $ind_tag, $auth_type )
2088 $auth_type contains :
2092 =item - nothing : rebuild a biblio. In UNIMARC the encoding is in 100$a pos 26/27
2094 =item - UNIMARCAUTH : rebuild an authority. In UNIMARC, the encoding is in 100$a pos 13/14
2096 =item - ITEM : rebuild an item : in UNIMARC, 100$a, it's in the biblio ! (otherwise, we would get 2 100 fields !)
2102 sub TransformHtmlToXml {
2103 my ( $tags, $subfields, $values, $indicator, $ind_tag, $auth_type ) = @_;
2104 my $xml = MARC::File::XML::header('UTF-8');
2105 $xml .= "<record>\n";
2106 $auth_type = C4::Context->preference('marcflavour') unless $auth_type;
2107 MARC::File::XML->default_record_format($auth_type);
2109 # in UNIMARC, field 100 contains the encoding
2110 # check that there is one, otherwise the
2111 # MARC::Record->new_from_xml will fail (and Koha will die)
2112 my $unimarc_and_100_exist = 0;
2113 $unimarc_and_100_exist = 1 if $auth_type eq 'ITEM'; # if we rebuild an item, no need of a 100 field
2118 for ( my $i = 0 ; $i < @$tags ; $i++ ) {
2120 if ( C4::Context->preference('marcflavour') eq 'UNIMARC' and @$tags[$i] eq "100" and @$subfields[$i] eq "a" ) {
2122 # if we have a 100 field and it's values are not correct, skip them.
2123 # if we don't have any valid 100 field, we will create a default one at the end
2124 my $enc = substr( @$values[$i], 26, 2 );
2125 if ( $enc eq '01' or $enc eq '50' or $enc eq '03' ) {
2126 $unimarc_and_100_exist = 1;
2131 @$values[$i] =~ s/&/&/g;
2132 @$values[$i] =~ s/</</g;
2133 @$values[$i] =~ s/>/>/g;
2134 @$values[$i] =~ s/"/"/g;
2135 @$values[$i] =~ s/'/'/g;
2137 # if ( !utf8::is_utf8( @$values[$i] ) ) {
2138 # utf8::decode( @$values[$i] );
2140 if ( ( @$tags[$i] ne $prevtag ) ) {
2141 $j++ unless ( @$tags[$i] eq "" );
2142 my $indicator1 = eval { substr( @$indicator[$j], 0, 1 ) };
2143 my $indicator2 = eval { substr( @$indicator[$j], 1, 1 ) };
2144 my $ind1 = _default_ind_to_space($indicator1);
2146 if ( @$indicator[$j] ) {
2147 $ind2 = _default_ind_to_space($indicator2);
2149 warn "Indicator in @$tags[$i] is empty";
2153 $xml .= "</datafield>\n";
2154 if ( ( @$tags[$i] && @$tags[$i] > 10 )
2155 && ( @$values[$i] ne "" ) ) {
2156 $xml .= "<datafield tag=\"@$tags[$i]\" ind1=\"$ind1\" ind2=\"$ind2\">\n";
2157 $xml .= "<subfield code=\"@$subfields[$i]\">@$values[$i]</subfield>\n";
2163 if ( @$values[$i] ne "" ) {
2166 if ( @$tags[$i] eq "000" ) {
2167 $xml .= "<leader>@$values[$i]</leader>\n";
2170 # rest of the fixed fields
2171 } elsif ( @$tags[$i] < 10 ) {
2172 $xml .= "<controlfield tag=\"@$tags[$i]\">@$values[$i]</controlfield>\n";
2175 $xml .= "<datafield tag=\"@$tags[$i]\" ind1=\"$ind1\" ind2=\"$ind2\">\n";
2176 $xml .= "<subfield code=\"@$subfields[$i]\">@$values[$i]</subfield>\n";
2181 } else { # @$tags[$i] eq $prevtag
2182 my $indicator1 = eval { substr( @$indicator[$j], 0, 1 ) };
2183 my $indicator2 = eval { substr( @$indicator[$j], 1, 1 ) };
2184 my $ind1 = _default_ind_to_space($indicator1);
2186 if ( @$indicator[$j] ) {
2187 $ind2 = _default_ind_to_space($indicator2);
2189 warn "Indicator in @$tags[$i] is empty";
2192 if ( @$values[$i] eq "" ) {
2195 $xml .= "<datafield tag=\"@$tags[$i]\" ind1=\"$ind1\" ind2=\"$ind2\">\n";
2198 $xml .= "<subfield code=\"@$subfields[$i]\">@$values[$i]</subfield>\n";
2201 $prevtag = @$tags[$i];
2203 $xml .= "</datafield>\n" if $xml =~ m/<datafield/;
2204 if ( C4::Context->preference('marcflavour') eq 'UNIMARC' and !$unimarc_and_100_exist ) {
2206 # warn "SETTING 100 for $auth_type";
2207 my $string = strftime( "%Y%m%d", localtime(time) );
2209 # set 50 to position 26 is biblios, 13 if authorities
2211 $pos = 13 if $auth_type eq 'UNIMARCAUTH';
2212 $string = sprintf( "%-*s", 35, $string );
2213 substr( $string, $pos, 6, "50" );
2214 $xml .= "<datafield tag=\"100\" ind1=\"\" ind2=\"\">\n";
2215 $xml .= "<subfield code=\"a\">$string</subfield>\n";
2216 $xml .= "</datafield>\n";
2218 $xml .= "</record>\n";
2219 $xml .= MARC::File::XML::footer();
2223 =head2 _default_ind_to_space
2225 Passed what should be an indicator returns a space
2226 if its undefined or zero length
2230 sub _default_ind_to_space {
2232 if ( !defined $s || $s eq q{} ) {
2238 =head2 TransformHtmlToMarc
2240 L<$record> = TransformHtmlToMarc(L<$cgi>)
2241 L<$cgi> is the CGI object which containts the values for subfields
2243 'tag_010_indicator1_531951' ,
2244 'tag_010_indicator2_531951' ,
2245 'tag_010_code_a_531951_145735' ,
2246 'tag_010_subfield_a_531951_145735' ,
2247 'tag_200_indicator1_873510' ,
2248 'tag_200_indicator2_873510' ,
2249 'tag_200_code_a_873510_673465' ,
2250 'tag_200_subfield_a_873510_673465' ,
2251 'tag_200_code_b_873510_704318' ,
2252 'tag_200_subfield_b_873510_704318' ,
2253 'tag_200_code_e_873510_280822' ,
2254 'tag_200_subfield_e_873510_280822' ,
2255 'tag_200_code_f_873510_110730' ,
2256 'tag_200_subfield_f_873510_110730' ,
2258 L<$record> is the MARC::Record object.
2262 sub TransformHtmlToMarc {
2265 my @params = $cgi->param();
2267 # explicitly turn on the UTF-8 flag for all
2268 # 'tag_' parameters to avoid incorrect character
2269 # conversion later on
2270 my $cgi_params = $cgi->Vars;
2271 foreach my $param_name ( keys %$cgi_params ) {
2272 if ( $param_name =~ /^tag_/ ) {
2273 my $param_value = $cgi_params->{$param_name};
2274 if ( utf8::decode($param_value) ) {
2275 $cgi_params->{$param_name} = $param_value;
2278 # FIXME - need to do something if string is not valid UTF-8
2282 # creating a new record
2283 my $record = MARC::Record->new();
2286 #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!
2287 while ( $params[$i] ) { # browse all CGI params
2288 my $param = $params[$i];
2291 # if we are on biblionumber, store it in the MARC::Record (it may not be in the edited fields)
2292 if ( $param eq 'biblionumber' ) {
2293 my ( $biblionumbertagfield, $biblionumbertagsubfield ) = &GetMarcFromKohaField( "biblio.biblionumber", '' );
2294 if ( $biblionumbertagfield < 10 ) {
2295 $newfield = MARC::Field->new( $biblionumbertagfield, $cgi->param($param), );
2297 $newfield = MARC::Field->new( $biblionumbertagfield, '', '', "$biblionumbertagsubfield" => $cgi->param($param), );
2299 push @fields, $newfield if ($newfield);
2300 } elsif ( $param =~ /^tag_(\d*)_indicator1_/ ) { # new field start when having 'input name="..._indicator1_..."
2303 my $ind1 = _default_ind_to_space( substr( $cgi->param($param), 0, 1 ) );
2304 my $ind2 = _default_ind_to_space( substr( $cgi->param( $params[ $i + 1 ] ), 0, 1 ) );
2308 if ( $tag < 10 ) { # no code for theses fields
2309 # in MARC editor, 000 contains the leader.
2310 if ( $tag eq '000' ) {
2311 # Force a fake leader even if not provided to avoid crashing
2312 # during decoding MARC record containing UTF-8 characters
2314 length( $cgi->param($params[$j+1]) ) == 24
2315 ? $cgi->param( $params[ $j + 1 ] )
2319 # between 001 and 009 (included)
2320 } elsif ( $cgi->param( $params[ $j + 1 ] ) ne '' ) {
2321 $newfield = MARC::Field->new( $tag, $cgi->param( $params[ $j + 1 ] ), );
2324 # > 009, deal with subfields
2326 # browse subfields for this tag (reason for _code_ match)
2327 while(defined $params[$j] && $params[$j] =~ /_code_/) {
2328 last unless defined $params[$j+1];
2329 #if next param ne subfield, then it was probably empty
2330 #try next param by incrementing j
2331 if($params[$j+1]!~/_subfield_/) {$j++; next; }
2332 my $fval= $cgi->param($params[$j+1]);
2333 #check if subfield value not empty and field exists
2334 if($fval ne '' && $newfield) {
2335 $newfield->add_subfields( $cgi->param($params[$j]) => $fval);
2337 elsif($fval ne '') {
2338 $newfield = MARC::Field->new( $tag, $ind1, $ind2, $cgi->param($params[$j]) => $fval );
2342 $i= $j-1; #update i for outer loop accordingly
2344 push @fields, $newfield if ($newfield);
2349 $record->append_fields(@fields);
2353 # cache inverted MARC field map
2354 our $inverted_field_map;
2356 =head2 TransformMarcToKoha
2358 $result = TransformMarcToKoha( $dbh, $record, $frameworkcode )
2360 Extract data from a MARC bib record into a hashref representing
2361 Koha biblio, biblioitems, and items fields.
2365 sub TransformMarcToKoha {
2366 my ( $dbh, $record, $frameworkcode, $limit_table ) = @_;
2369 $limit_table = $limit_table || 0;
2370 $frameworkcode = '' unless defined $frameworkcode;
2372 unless ( defined $inverted_field_map ) {
2373 $inverted_field_map = _get_inverted_marc_field_map();
2377 if ( defined $limit_table && $limit_table eq 'items' ) {
2378 $tables{'items'} = 1;
2380 $tables{'items'} = 1;
2381 $tables{'biblio'} = 1;
2382 $tables{'biblioitems'} = 1;
2385 # traverse through record
2386 MARCFIELD: foreach my $field ( $record->fields() ) {
2387 my $tag = $field->tag();
2388 next MARCFIELD unless exists $inverted_field_map->{$frameworkcode}->{$tag};
2389 if ( $field->is_control_field() ) {
2390 my $kohafields = $inverted_field_map->{$frameworkcode}->{$tag}->{list};
2391 ENTRY: foreach my $entry ( @{$kohafields} ) {
2392 my ( $subfield, $table, $column ) = @{$entry};
2393 next ENTRY unless exists $tables{$table};
2394 my $key = _disambiguate( $table, $column );
2395 if ( $result->{$key} ) {
2396 unless ( ( $key eq "biblionumber" or $key eq "biblioitemnumber" ) and ( $field->data() eq "" ) ) {
2397 $result->{$key} .= " | " . $field->data();
2400 $result->{$key} = $field->data();
2405 # deal with subfields
2406 MARCSUBFIELD: foreach my $sf ( $field->subfields() ) {
2407 my $code = $sf->[0];
2408 next MARCSUBFIELD unless exists $inverted_field_map->{$frameworkcode}->{$tag}->{sfs}->{$code};
2409 my $value = $sf->[1];
2410 SFENTRY: foreach my $entry ( @{ $inverted_field_map->{$frameworkcode}->{$tag}->{sfs}->{$code} } ) {
2411 my ( $table, $column ) = @{$entry};
2412 next SFENTRY unless exists $tables{$table};
2413 my $key = _disambiguate( $table, $column );
2414 if ( $result->{$key} ) {
2415 unless ( ( $key eq "biblionumber" or $key eq "biblioitemnumber" ) and ( $value eq "" ) ) {
2416 $result->{$key} .= " | " . $value;
2419 $result->{$key} = $value;
2426 # modify copyrightdate to keep only the 1st year found
2427 if ( exists $result->{'copyrightdate'} ) {
2428 my $temp = $result->{'copyrightdate'};
2429 $temp =~ m/c(\d\d\d\d)/;
2430 if ( $temp =~ m/c(\d\d\d\d)/ and $1 > 0 ) { # search cYYYY first
2431 $result->{'copyrightdate'} = $1;
2432 } else { # if no cYYYY, get the 1st date.
2433 $temp =~ m/(\d\d\d\d)/;
2434 $result->{'copyrightdate'} = $1;
2438 # modify publicationyear to keep only the 1st year found
2439 if ( exists $result->{'publicationyear'} ) {
2440 my $temp = $result->{'publicationyear'};
2441 if ( $temp =~ m/c(\d\d\d\d)/ and $1 > 0 ) { # search cYYYY first
2442 $result->{'publicationyear'} = $1;
2443 } else { # if no cYYYY, get the 1st date.
2444 $temp =~ m/(\d\d\d\d)/;
2445 $result->{'publicationyear'} = $1;
2452 sub _get_inverted_marc_field_map {
2454 my $relations = C4::Context->marcfromkohafield;
2456 foreach my $frameworkcode ( keys %{$relations} ) {
2457 foreach my $kohafield ( keys %{ $relations->{$frameworkcode} } ) {
2458 next unless @{ $relations->{$frameworkcode}->{$kohafield} }; # not all columns are mapped to MARC tag & subfield
2459 my $tag = $relations->{$frameworkcode}->{$kohafield}->[0];
2460 my $subfield = $relations->{$frameworkcode}->{$kohafield}->[1];
2461 my ( $table, $column ) = split /[.]/, $kohafield, 2;
2462 push @{ $field_map->{$frameworkcode}->{$tag}->{list} }, [ $subfield, $table, $column ];
2463 push @{ $field_map->{$frameworkcode}->{$tag}->{sfs}->{$subfield} }, [ $table, $column ];
2469 =head2 _disambiguate
2471 $newkey = _disambiguate($table, $field);
2473 This is a temporary hack to distinguish between the
2474 following sets of columns when using TransformMarcToKoha.
2476 items.cn_source & biblioitems.cn_source
2477 items.cn_sort & biblioitems.cn_sort
2479 Columns that are currently NOT distinguished (FIXME
2480 due to lack of time to fully test) are:
2482 biblio.notes and biblioitems.notes
2487 FIXME - this is necessary because prefixing each column
2488 name with the table name would require changing lots
2489 of code and templates, and exposing more of the DB
2490 structure than is good to the UI templates, particularly
2491 since biblio and bibloitems may well merge in a future
2492 version. In the future, it would also be good to
2493 separate DB access and UI presentation field names
2498 sub CountItemsIssued {
2499 my ($biblionumber) = @_;
2500 my $dbh = C4::Context->dbh;
2501 my $sth = $dbh->prepare('SELECT COUNT(*) as issuedCount FROM items, issues WHERE items.itemnumber = issues.itemnumber AND items.biblionumber = ?');
2502 $sth->execute($biblionumber);
2503 my $row = $sth->fetchrow_hashref();
2504 return $row->{'issuedCount'};
2508 my ( $table, $column ) = @_;
2509 if ( $column eq "cn_sort" or $column eq "cn_source" ) {
2510 return $table . '.' . $column;
2517 =head2 get_koha_field_from_marc
2519 $result->{_disambiguate($table, $field)} =
2520 get_koha_field_from_marc($table,$field,$record,$frameworkcode);
2522 Internal function to map data from the MARC record to a specific non-MARC field.
2523 FIXME: this is meant to replace TransformMarcToKohaOneField after more testing.
2527 sub get_koha_field_from_marc {
2528 my ( $koha_table, $koha_column, $record, $frameworkcode ) = @_;
2529 my ( $tagfield, $subfield ) = GetMarcFromKohaField( $koha_table . '.' . $koha_column, $frameworkcode );
2531 foreach my $field ( $record->field($tagfield) ) {
2532 if ( $field->tag() < 10 ) {
2534 $kohafield .= " | " . $field->data();
2536 $kohafield = $field->data();
2539 if ( $field->subfields ) {
2540 my @subfields = $field->subfields();
2541 foreach my $subfieldcount ( 0 .. $#subfields ) {
2542 if ( $subfields[$subfieldcount][0] eq $subfield ) {
2544 $kohafield .= " | " . $subfields[$subfieldcount][1];
2546 $kohafield = $subfields[$subfieldcount][1];
2556 =head2 TransformMarcToKohaOneField
2558 $result = TransformMarcToKohaOneField( $kohatable, $kohafield, $record, $result, $frameworkcode )
2562 sub TransformMarcToKohaOneField {
2564 # FIXME ? if a field has a repeatable subfield that is used in old-db,
2565 # only the 1st will be retrieved...
2566 my ( $kohatable, $kohafield, $record, $result, $frameworkcode ) = @_;
2568 my ( $tagfield, $subfield ) = GetMarcFromKohaField( $kohatable . "." . $kohafield, $frameworkcode );
2569 foreach my $field ( $record->field($tagfield) ) {
2570 if ( $field->tag() < 10 ) {
2571 if ( $result->{$kohafield} ) {
2572 $result->{$kohafield} .= " | " . $field->data();
2574 $result->{$kohafield} = $field->data();
2577 if ( $field->subfields ) {
2578 my @subfields = $field->subfields();
2579 foreach my $subfieldcount ( 0 .. $#subfields ) {
2580 if ( $subfields[$subfieldcount][0] eq $subfield ) {
2581 if ( $result->{$kohafield} ) {
2582 $result->{$kohafield} .= " | " . $subfields[$subfieldcount][1];
2584 $result->{$kohafield} = $subfields[$subfieldcount][1];
2598 # true ModZebra commented until indexdata fixes zebraDB crashes (it seems they occur on multiple updates
2600 # replaced by a zebraqueue table, that is filled with ModZebra to run.
2601 # the table is emptied by misc/cronjobs/zebraqueue_start.pl script
2602 # =head2 ModZebrafiles
2604 # &ModZebrafiles( $dbh, $biblionumber, $record, $folder, $server );
2608 # sub ModZebrafiles {
2610 # my ( $dbh, $biblionumber, $record, $folder, $server ) = @_;
2614 # C4::Context->zebraconfig($server)->{directory} . "/" . $folder . "/";
2615 # unless ( opendir( DIR, "$zebradir" ) ) {
2616 # warn "$zebradir not found";
2620 # my $filename = $zebradir . $biblionumber;
2623 # open( OUTPUT, ">", $filename . ".xml" );
2624 # print OUTPUT $record;
2631 ModZebra( $biblionumber, $op, $server, $oldRecord, $newRecord );
2633 $biblionumber is the biblionumber we want to index
2635 $op is specialUpdate or delete, and is used to know what we want to do
2637 $server is the server that we want to update
2639 $oldRecord is the MARC::Record containing the previous version of the record. This is used only when
2640 NoZebra=1, as NoZebra indexing needs to know the previous version of a record in order to
2643 $newRecord is the MARC::Record containing the new record. It is usefull only when NoZebra=1, and is used to know what to add to the nozebra database. (the record in mySQL being, if it exist, the previous record, the one just before the modif. We need both : the previous and the new one.
2648 ###Accepts a $server variable thus we can use it for biblios authorities or other zebra dbs
2649 my ( $biblionumber, $op, $server, $oldRecord, $newRecord ) = @_;
2650 my $dbh = C4::Context->dbh;
2652 # true ModZebra commented until indexdata fixes zebraDB crashes (it seems they occur on multiple updates
2654 # replaced by a zebraqueue table, that is filled with ModZebra to run.
2655 # the table is emptied by misc/cronjobs/zebraqueue_start.pl script
2657 if ( C4::Context->preference("NoZebra") ) {
2659 # lock the nozebra table : we will read index lines, update them in Perl process
2660 # and write everything in 1 transaction.
2661 # lock the table to avoid someone else overwriting what we are doing
2662 $dbh->do('LOCK TABLES nozebra WRITE,biblio WRITE,biblioitems WRITE, systempreferences WRITE, auth_types WRITE, auth_header WRITE, auth_subfield_structure READ');
2663 my %result; # the result hash that will be built by deletion / add, and written on mySQL at the end, to improve speed
2664 if ( $op eq 'specialUpdate' ) {
2666 # OK, we have to add or update the record
2667 # 1st delete (virtually, in indexes), if record actually exists
2669 %result = _DelBiblioNoZebra( $biblionumber, $oldRecord, $server );
2672 # ... add the record
2673 %result = _AddBiblioNoZebra( $biblionumber, $newRecord, $server, %result );
2676 # it's a deletion, delete the record...
2677 # warn "DELETE the record $biblionumber on $server".$record->as_formatted;
2678 %result = _DelBiblioNoZebra( $biblionumber, $oldRecord, $server );
2681 # ok, now update the database...
2682 my $sth = $dbh->prepare("UPDATE nozebra SET biblionumbers=? WHERE server=? AND indexname=? AND value=?");
2683 foreach my $key ( keys %result ) {
2684 foreach my $index ( keys %{ $result{$key} } ) {
2685 $sth->execute( $result{$key}->{$index}, $server, $key, $index );
2688 $dbh->do('UNLOCK TABLES');
2692 # we use zebra, just fill zebraqueue table
2694 my $check_sql = "SELECT COUNT(*) FROM zebraqueue
2696 AND biblio_auth_number = ?
2699 my $check_sth = $dbh->prepare_cached($check_sql);
2700 $check_sth->execute( $server, $biblionumber, $op );
2701 my ($count) = $check_sth->fetchrow_array;
2702 $check_sth->finish();
2703 if ( $count == 0 ) {
2704 my $sth = $dbh->prepare("INSERT INTO zebraqueue (biblio_auth_number,server,operation) VALUES(?,?,?)");
2705 $sth->execute( $biblionumber, $server, $op );
2711 =head2 GetNoZebraIndexes
2713 %indexes = GetNoZebraIndexes;
2715 return the data from NoZebraIndexes syspref.
2719 sub GetNoZebraIndexes {
2720 my $no_zebra_indexes = C4::Context->preference('NoZebraIndexes');
2722 INDEX: foreach my $line ( split /['"],[\n\r]*/, $no_zebra_indexes ) {
2723 $line =~ /(.*)=>(.*)/;
2724 my $index = $1; # initial ' or " is removed afterwards
2726 $index =~ s/'|"|\s//g;
2727 $fields =~ s/'|"|\s//g;
2728 $indexes{$index} = $fields;
2733 =head2 EmbedItemsInMarcBiblio
2735 EmbedItemsInMarcBiblio($marc, $biblionumber);
2737 Given a MARC::Record object containing a bib record,
2738 modify it to include the items attached to it as 9XX
2739 per the bib's MARC framework.
2743 sub EmbedItemsInMarcBiblio {
2744 my ($marc, $biblionumber) = @_;
2745 croak "No MARC record" unless $marc;
2747 my $frameworkcode = GetFrameworkCode($biblionumber);
2748 _strip_item_fields($marc, $frameworkcode);
2750 # ... and embed the current items
2751 my $dbh = C4::Context->dbh;
2752 my $sth = $dbh->prepare("SELECT itemnumber FROM items WHERE biblionumber = ?");
2753 $sth->execute($biblionumber);
2755 my ( $itemtag, $itemsubfield ) = GetMarcFromKohaField( "items.itemnumber", $frameworkcode );
2756 while (my ($itemnumber) = $sth->fetchrow_array) {
2758 my $item_marc = C4::Items::GetMarcItem($biblionumber, $itemnumber);
2759 push @item_fields, $item_marc->field($itemtag);
2761 $marc->append_fields(@item_fields);
2764 =head1 INTERNAL FUNCTIONS
2766 =head2 _DelBiblioNoZebra($biblionumber,$record,$server);
2768 function to delete a biblio in NoZebra indexes
2769 This function does NOT delete anything in database : it reads all the indexes entries
2770 that have to be deleted & delete them in the hash
2772 The SQL part is done either :
2773 - after the Add if we are modifying a biblio (delete + add again)
2774 - immediatly after this sub if we are doing a true deletion.
2776 $server can be 'biblioserver' or 'authorityserver' : it indexes biblios or authorities (in the same table, $server being part of the table itself
2780 sub _DelBiblioNoZebra {
2781 my ( $biblionumber, $record, $server ) = @_;
2784 my $dbh = C4::Context->dbh;
2789 if ( $server eq 'biblioserver' ) {
2790 %index = GetNoZebraIndexes;
2792 # get title of the record (to store the 10 first letters with the index)
2793 my ( $titletag, $titlesubfield ) = GetMarcFromKohaField( 'biblio.title', '' ); # FIXME: should be GetFrameworkCode($biblionumber) ??
2794 $title = lc( $record->subfield( $titletag, $titlesubfield ) );
2797 # for authorities, the "title" is the $a mainentry
2798 my ( $auth_type_tag, $auth_type_sf ) = C4::AuthoritiesMarc::get_auth_type_location();
2799 my $authref = C4::AuthoritiesMarc::GetAuthType( $record->subfield( $auth_type_tag, $auth_type_sf ) );
2800 warn "ERROR : authtype undefined for " . $record->as_formatted unless $authref;
2801 $title = $record->subfield( $authref->{auth_tag_to_report}, 'a' );
2802 $index{'mainmainentry'} = $authref->{'auth_tag_to_report'} . 'a';
2803 $index{'mainentry'} = $authref->{'auth_tag_to_report'} . '*';
2804 $index{'auth_type'} = "${auth_type_tag}${auth_type_sf}";
2809 # remove blancks comma (that could cause problem when decoding the string for CQL retrieval) and regexp specific values
2810 $title =~ s/ |,|;|\[|\]|\(|\)|\*|-|'|=//g;
2812 # limit to 10 char, should be enough, and limit the DB size
2813 $title = substr( $title, 0, 10 );
2816 my $sth2 = $dbh->prepare('SELECT biblionumbers FROM nozebra WHERE server=? AND indexname=? AND value=?');
2817 foreach my $field ( $record->fields() ) {
2819 #parse each subfield
2820 next if $field->tag < 10;
2821 foreach my $subfield ( $field->subfields() ) {
2822 my $tag = $field->tag();
2823 my $subfieldcode = $subfield->[0];
2826 # check each index to see if the subfield is stored somewhere
2827 # otherwise, store it in __RAW__ index
2828 foreach my $key ( keys %index ) {
2830 # warn "examining $key index : ".$index{$key}." for $tag $subfieldcode";
2831 if ( $index{$key} =~ /$tag\*/ or $index{$key} =~ /$tag$subfieldcode/ ) {
2833 my $line = lc $subfield->[1];
2835 # remove meaningless value in the field...
2836 $line =~ s/-|\.|\?|,|;|!|'|\(|\)|\[|\]|{|}|"|<|>|&|\+|\*|\/|=|:/ /g;
2838 # ... and split in words
2839 foreach ( split / /, $line ) {
2840 next unless $_; # skip empty values (multiple spaces)
2841 # if the entry is already here, do nothing, the biblionumber has already be removed
2842 unless ( defined( $result{$key}->{$_} ) && ( $result{$key}->{$_} =~ /$biblionumber,$title\-(\d);/ ) ) {
2844 # get the index value if it exist in the nozebra table and remove the entry, otherwise, do nothing
2845 $sth2->execute( $server, $key, $_ );
2846 my $existing_biblionumbers = $sth2->fetchrow;
2849 if ($existing_biblionumbers) {
2851 # warn " existing for $key $_: $existing_biblionumbers";
2852 $result{$key}->{$_} = $existing_biblionumbers;
2853 $result{$key}->{$_} =~ s/$biblionumber,$title\-(\d);//;
2860 # the subfield is not indexed, store it in __RAW__ index anyway
2862 my $line = lc $subfield->[1];
2863 $line =~ s/-|\.|\?|,|;|!|'|\(|\)|\[|\]|{|}|"|<|>|&|\+|\*|\/|=|:/ /g;
2865 # ... and split in words
2866 foreach ( split / /, $line ) {
2867 next unless $_; # skip empty values (multiple spaces)
2868 # if the entry is already here, do nothing, the biblionumber has already be removed
2869 unless ( $result{'__RAW__'}->{$_} =~ /$biblionumber,$title\-(\d);/ ) {
2871 # get the index value if it exist in the nozebra table and remove the entry, otherwise, do nothing
2872 $sth2->execute( $server, '__RAW__', $_ );
2873 my $existing_biblionumbers = $sth2->fetchrow;
2876 if ($existing_biblionumbers) {
2877 $result{'__RAW__'}->{$_} = $existing_biblionumbers;
2878 $result{'__RAW__'}->{$_} =~ s/$biblionumber,$title\-(\d);//;
2888 =head2 _AddBiblioNoZebra
2890 _AddBiblioNoZebra($biblionumber, $record, $server, %result);
2892 function to add a biblio in NoZebra indexes
2896 sub _AddBiblioNoZebra {
2897 my ( $biblionumber, $record, $server, %result ) = @_;
2898 my $dbh = C4::Context->dbh;
2903 if ( $server eq 'biblioserver' ) {
2904 %index = GetNoZebraIndexes;
2906 # get title of the record (to store the 10 first letters with the index)
2907 my ( $titletag, $titlesubfield ) = GetMarcFromKohaField( 'biblio.title', '' ); # FIXME: should be GetFrameworkCode($biblionumber) ??
2908 $title = lc( $record->subfield( $titletag, $titlesubfield ) );
2911 # warn "server : $server";
2912 # for authorities, the "title" is the $a mainentry
2913 my ( $auth_type_tag, $auth_type_sf ) = C4::AuthoritiesMarc::get_auth_type_location();
2914 my $authref = C4::AuthoritiesMarc::GetAuthType( $record->subfield( $auth_type_tag, $auth_type_sf ) );
2915 warn "ERROR : authtype undefined for " . $record->as_formatted unless $authref;
2916 $title = $record->subfield( $authref->{auth_tag_to_report}, 'a' );
2917 $index{'mainmainentry'} = $authref->{auth_tag_to_report} . 'a';
2918 $index{'mainentry'} = $authref->{auth_tag_to_report} . '*';
2919 $index{'auth_type'} = "${auth_type_tag}${auth_type_sf}";
2922 # remove blancks comma (that could cause problem when decoding the string for CQL retrieval) and regexp specific values
2923 $title =~ s/ |\.|,|;|\[|\]|\(|\)|\*|-|'|:|=|\r|\n//g;
2925 # limit to 10 char, should be enough, and limit the DB size
2926 $title = substr( $title, 0, 10 );
2929 my $sth2 = $dbh->prepare('SELECT biblionumbers FROM nozebra WHERE server=? AND indexname=? AND value=?');
2930 foreach my $field ( $record->fields() ) {
2932 #parse each subfield
2933 ###FIXME: impossible to index a 001-009 value with NoZebra
2934 next if $field->tag < 10;
2935 foreach my $subfield ( $field->subfields() ) {
2936 my $tag = $field->tag();
2937 my $subfieldcode = $subfield->[0];
2940 # warn "INDEXING :".$subfield->[1];
2941 # check each index to see if the subfield is stored somewhere
2942 # otherwise, store it in __RAW__ index
2943 foreach my $key ( keys %index ) {
2945 # warn "examining $key index : ".$index{$key}." for $tag $subfieldcode";
2946 if ( $index{$key} =~ /$tag\*/ or $index{$key} =~ /$tag$subfieldcode/ ) {
2948 my $line = lc $subfield->[1];
2950 # remove meaningless value in the field...
2951 $line =~ s/-|\.|\?|,|;|!|'|\(|\)|\[|\]|{|}|"|<|>|&|\+|\*|\/|=|:|\r|\n/ /g;
2953 # ... and split in words
2954 foreach ( split / /, $line ) {
2955 next unless $_; # skip empty values (multiple spaces)
2956 # if the entry is already here, improve weight
2958 # warn "managing $_";
2959 if ( exists $result{$key}->{$_} && $result{$key}->{"$_"} =~ /$biblionumber,\Q$title\E\-(\d+);/ ) {
2960 my $weight = $1 + 1;
2961 $result{$key}->{"$_"} =~ s/$biblionumber,\Q$title\E\-(\d+);//g;
2962 $result{$key}->{"$_"} .= "$biblionumber,$title-$weight;";
2965 # get the value if it exist in the nozebra table, otherwise, create it
2966 $sth2->execute( $server, $key, $_ );
2967 my $existing_biblionumbers = $sth2->fetchrow;
2970 if ($existing_biblionumbers) {
2971 $result{$key}->{"$_"} = $existing_biblionumbers;
2972 my $weight = defined $1 ? $1 + 1 : 1;
2973 $result{$key}->{"$_"} =~ s/$biblionumber,\Q$title\E\-(\d+);//g;
2974 $result{$key}->{"$_"} .= "$biblionumber,$title-$weight;";
2976 # create a new ligne for this entry
2979 # warn "INSERT : $server / $key / $_";
2980 $dbh->do( 'INSERT INTO nozebra SET server=' . $dbh->quote($server) . ', indexname=' . $dbh->quote($key) . ',value=' . $dbh->quote($_) );
2981 $result{$key}->{"$_"} .= "$biblionumber,$title-1;";
2988 # the subfield is not indexed, store it in __RAW__ index anyway
2990 my $line = lc $subfield->[1];
2991 $line =~ s/-|\.|\?|,|;|!|'|\(|\)|\[|\]|{|}|"|<|>|&|\+|\*|\/|=|:|\r|\n/ /g;
2993 # ... and split in words
2994 foreach ( split / /, $line ) {
2995 next unless $_; # skip empty values (multiple spaces)
2996 # if the entry is already here, improve weight
2997 my $tmpstr = $result{'__RAW__'}->{"$_"} || "";
2998 if ( $tmpstr =~ /$biblionumber,\Q$title\E\-(\d+);/ ) {
2999 my $weight = $1 + 1;
3000 $result{'__RAW__'}->{"$_"} =~ s/$biblionumber,\Q$title\E\-(\d+);//;
3001 $result{'__RAW__'}->{"$_"} .= "$biblionumber,$title-$weight;";
3004 # get the value if it exist in the nozebra table, otherwise, create it
3005 $sth2->execute( $server, '__RAW__', $_ );
3006 my $existing_biblionumbers = $sth2->fetchrow;
3009 if ($existing_biblionumbers) {
3010 $result{'__RAW__'}->{"$_"} = $existing_biblionumbers;
3011 my $weight = ( $1 ? $1 : 0 ) + 1;
3012 $result{'__RAW__'}->{"$_"} =~ s/$biblionumber,\Q$title\E\-(\d+);//;
3013 $result{'__RAW__'}->{"$_"} .= "$biblionumber,$title-$weight;";
3015 # create a new ligne for this entry
3017 $dbh->do( 'INSERT INTO nozebra SET server=' . $dbh->quote($server) . ', indexname="__RAW__",value=' . $dbh->quote($_) );
3018 $result{'__RAW__'}->{"$_"} .= "$biblionumber,$title-1;";
3028 =head2 _koha_marc_update_bib_ids
3031 _koha_marc_update_bib_ids($record, $frameworkcode, $biblionumber, $biblioitemnumber);
3033 Internal function to add or update biblionumber and biblioitemnumber to
3038 sub _koha_marc_update_bib_ids {
3039 my ( $record, $frameworkcode, $biblionumber, $biblioitemnumber ) = @_;
3041 # we must add bibnum and bibitemnum in MARC::Record...
3042 # we build the new field with biblionumber and biblioitemnumber
3043 # we drop the original field
3044 # we add the new builded field.
3045 my ( $biblio_tag, $biblio_subfield ) = GetMarcFromKohaField( "biblio.biblionumber", $frameworkcode );
3046 die qq{No biblionumber tag for framework "$frameworkcode"} unless $biblio_tag;
3047 my ( $biblioitem_tag, $biblioitem_subfield ) = GetMarcFromKohaField( "biblioitems.biblioitemnumber", $frameworkcode );
3048 die qq{No biblioitemnumber tag for framework "$frameworkcode"} unless $biblio_tag;
3050 if ( $biblio_tag == $biblioitem_tag ) {
3052 # biblionumber & biblioitemnumber are in the same field (can't be <10 as fields <10 have only 1 value)
3053 my $new_field = MARC::Field->new(
3054 $biblio_tag, '', '',
3055 "$biblio_subfield" => $biblionumber,
3056 "$biblioitem_subfield" => $biblioitemnumber
3059 # drop old field and create new one...
3060 my $old_field = $record->field($biblio_tag);
3061 $record->delete_field($old_field) if $old_field;
3062 $record->insert_fields_ordered($new_field);
3065 # biblionumber & biblioitemnumber are in different fields
3067 # deal with biblionumber
3068 my ( $new_field, $old_field );
3069 if ( $biblio_tag < 10 ) {
3070 $new_field = MARC::Field->new( $biblio_tag, $biblionumber );
3072 $new_field = MARC::Field->new( $biblio_tag, '', '', "$biblio_subfield" => $biblionumber );
3075 # drop old field and create new one...
3076 $old_field = $record->field($biblio_tag);
3077 $record->delete_field($old_field) if $old_field;
3078 $record->insert_fields_ordered($new_field);
3080 # deal with biblioitemnumber
3081 if ( $biblioitem_tag < 10 ) {
3082 $new_field = MARC::Field->new( $biblioitem_tag, $biblioitemnumber, );
3084 $new_field = MARC::Field->new( $biblioitem_tag, '', '', "$biblioitem_subfield" => $biblioitemnumber, );
3087 # drop old field and create new one...
3088 $old_field = $record->field($biblioitem_tag);
3089 $record->delete_field($old_field) if $old_field;
3090 $record->insert_fields_ordered($new_field);
3094 =head2 _koha_marc_update_biblioitem_cn_sort
3096 _koha_marc_update_biblioitem_cn_sort($marc, $biblioitem, $frameworkcode);
3098 Given a MARC bib record and the biblioitem hash, update the
3099 subfield that contains a copy of the value of biblioitems.cn_sort.
3103 sub _koha_marc_update_biblioitem_cn_sort {
3105 my $biblioitem = shift;
3106 my $frameworkcode = shift;
3108 my ( $biblioitem_tag, $biblioitem_subfield ) = GetMarcFromKohaField( "biblioitems.cn_sort", $frameworkcode );
3109 return unless $biblioitem_tag;
3111 my ($cn_sort) = GetClassSort( $biblioitem->{'biblioitems.cn_source'}, $biblioitem->{'cn_class'}, $biblioitem->{'cn_item'} );
3113 if ( my $field = $marc->field($biblioitem_tag) ) {
3114 $field->delete_subfield( code => $biblioitem_subfield );
3115 if ( $cn_sort ne '' ) {
3116 $field->add_subfields( $biblioitem_subfield => $cn_sort );
3120 # if we get here, no biblioitem tag is present in the MARC record, so
3121 # we'll create it if $cn_sort is not empty -- this would be
3122 # an odd combination of events, however
3124 $marc->insert_grouped_field( MARC::Field->new( $biblioitem_tag, ' ', ' ', $biblioitem_subfield => $cn_sort ) );
3129 =head2 _koha_add_biblio
3131 my ($biblionumber,$error) = _koha_add_biblio($dbh,$biblioitem);
3133 Internal function to add a biblio ($biblio is a hash with the values)
3137 sub _koha_add_biblio {
3138 my ( $dbh, $biblio, $frameworkcode ) = @_;
3142 # set the series flag
3143 unless (defined $biblio->{'serial'}){
3144 $biblio->{'serial'} = 0;
3145 if ( $biblio->{'seriestitle'} ) { $biblio->{'serial'} = 1 }
3148 my $query = "INSERT INTO biblio
3149 SET frameworkcode = ?,
3160 my $sth = $dbh->prepare($query);
3162 $frameworkcode, $biblio->{'author'}, $biblio->{'title'}, $biblio->{'unititle'}, $biblio->{'notes'},
3163 $biblio->{'serial'}, $biblio->{'seriestitle'}, $biblio->{'copyrightdate'}, $biblio->{'abstract'}
3166 my $biblionumber = $dbh->{'mysql_insertid'};
3167 if ( $dbh->errstr ) {
3168 $error .= "ERROR in _koha_add_biblio $query" . $dbh->errstr;
3174 #warn "LEAVING _koha_add_biblio: ".$biblionumber."\n";
3175 return ( $biblionumber, $error );
3178 =head2 _koha_modify_biblio
3180 my ($biblionumber,$error) == _koha_modify_biblio($dbh,$biblio,$frameworkcode);
3182 Internal function for updating the biblio table
3186 sub _koha_modify_biblio {
3187 my ( $dbh, $biblio, $frameworkcode ) = @_;
3192 SET frameworkcode = ?,
3201 WHERE biblionumber = ?
3204 my $sth = $dbh->prepare($query);
3207 $frameworkcode, $biblio->{'author'}, $biblio->{'title'}, $biblio->{'unititle'}, $biblio->{'notes'},
3208 $biblio->{'serial'}, $biblio->{'seriestitle'}, $biblio->{'copyrightdate'}, $biblio->{'abstract'}, $biblio->{'biblionumber'}
3209 ) if $biblio->{'biblionumber'};
3211 if ( $dbh->errstr || !$biblio->{'biblionumber'} ) {
3212 $error .= "ERROR in _koha_modify_biblio $query" . $dbh->errstr;
3215 return ( $biblio->{'biblionumber'}, $error );
3218 =head2 _koha_modify_biblioitem_nonmarc
3220 my ($biblioitemnumber,$error) = _koha_modify_biblioitem_nonmarc( $dbh, $biblioitem );
3222 Updates biblioitems row except for marc and marcxml, which should be changed
3227 sub _koha_modify_biblioitem_nonmarc {
3228 my ( $dbh, $biblioitem ) = @_;
3231 # re-calculate the cn_sort, it may have changed
3232 my ($cn_sort) = GetClassSort( $biblioitem->{'biblioitems.cn_source'}, $biblioitem->{'cn_class'}, $biblioitem->{'cn_item'} );
3234 my $query = "UPDATE biblioitems
3235 SET biblionumber = ?,
3241 publicationyear = ?,
3245 collectiontitle = ?,
3247 collectionvolume= ?,
3248 editionstatement= ?,
3249 editionresponsibility = ?,
3263 where biblioitemnumber = ?
3265 my $sth = $dbh->prepare($query);
3267 $biblioitem->{'biblionumber'}, $biblioitem->{'volume'}, $biblioitem->{'number'}, $biblioitem->{'itemtype'},
3268 $biblioitem->{'isbn'}, $biblioitem->{'issn'}, $biblioitem->{'publicationyear'}, $biblioitem->{'publishercode'},
3269 $biblioitem->{'volumedate'}, $biblioitem->{'volumedesc'}, $biblioitem->{'collectiontitle'}, $biblioitem->{'collectionissn'},
3270 $biblioitem->{'collectionvolume'}, $biblioitem->{'editionstatement'}, $biblioitem->{'editionresponsibility'}, $biblioitem->{'illus'},
3271 $biblioitem->{'pages'}, $biblioitem->{'bnotes'}, $biblioitem->{'size'}, $biblioitem->{'place'},
3272 $biblioitem->{'lccn'}, $biblioitem->{'url'}, $biblioitem->{'biblioitems.cn_source'}, $biblioitem->{'cn_class'},
3273 $biblioitem->{'cn_item'}, $biblioitem->{'cn_suffix'}, $cn_sort, $biblioitem->{'totalissues'},
3274 $biblioitem->{'biblioitemnumber'}
3276 if ( $dbh->errstr ) {
3277 $error .= "ERROR in _koha_modify_biblioitem_nonmarc $query" . $dbh->errstr;
3280 return ( $biblioitem->{'biblioitemnumber'}, $error );
3283 =head2 _koha_add_biblioitem
3285 my ($biblioitemnumber,$error) = _koha_add_biblioitem( $dbh, $biblioitem );
3287 Internal function to add a biblioitem
3291 sub _koha_add_biblioitem {
3292 my ( $dbh, $biblioitem ) = @_;
3295 my ($cn_sort) = GetClassSort( $biblioitem->{'biblioitems.cn_source'}, $biblioitem->{'cn_class'}, $biblioitem->{'cn_item'} );
3296 my $query = "INSERT INTO biblioitems SET
3303 publicationyear = ?,
3307 collectiontitle = ?,
3309 collectionvolume= ?,
3310 editionstatement= ?,
3311 editionresponsibility = ?,
3327 my $sth = $dbh->prepare($query);
3329 $biblioitem->{'biblionumber'}, $biblioitem->{'volume'}, $biblioitem->{'number'}, $biblioitem->{'itemtype'},
3330 $biblioitem->{'isbn'}, $biblioitem->{'issn'}, $biblioitem->{'publicationyear'}, $biblioitem->{'publishercode'},
3331 $biblioitem->{'volumedate'}, $biblioitem->{'volumedesc'}, $biblioitem->{'collectiontitle'}, $biblioitem->{'collectionissn'},
3332 $biblioitem->{'collectionvolume'}, $biblioitem->{'editionstatement'}, $biblioitem->{'editionresponsibility'}, $biblioitem->{'illus'},
3333 $biblioitem->{'pages'}, $biblioitem->{'bnotes'}, $biblioitem->{'size'}, $biblioitem->{'place'},
3334 $biblioitem->{'lccn'}, $biblioitem->{'marc'}, $biblioitem->{'url'}, $biblioitem->{'biblioitems.cn_source'},
3335 $biblioitem->{'cn_class'}, $biblioitem->{'cn_item'}, $biblioitem->{'cn_suffix'}, $cn_sort,
3336 $biblioitem->{'totalissues'}
3338 my $bibitemnum = $dbh->{'mysql_insertid'};
3340 if ( $dbh->errstr ) {
3341 $error .= "ERROR in _koha_add_biblioitem $query" . $dbh->errstr;
3345 return ( $bibitemnum, $error );
3348 =head2 _koha_delete_biblio
3350 $error = _koha_delete_biblio($dbh,$biblionumber);
3352 Internal sub for deleting from biblio table -- also saves to deletedbiblio
3354 C<$dbh> - the database handle
3356 C<$biblionumber> - the biblionumber of the biblio to be deleted
3360 # FIXME: add error handling
3362 sub _koha_delete_biblio {
3363 my ( $dbh, $biblionumber ) = @_;
3365 # get all the data for this biblio
3366 my $sth = $dbh->prepare("SELECT * FROM biblio WHERE biblionumber=?");
3367 $sth->execute($biblionumber);
3369 if ( my $data = $sth->fetchrow_hashref ) {
3371 # save the record in deletedbiblio
3372 # find the fields to save
3373 my $query = "INSERT INTO deletedbiblio SET ";
3375 foreach my $temp ( keys %$data ) {
3376 $query .= "$temp = ?,";
3377 push( @bind, $data->{$temp} );
3380 # replace the last , by ",?)"
3382 my $bkup_sth = $dbh->prepare($query);
3383 $bkup_sth->execute(@bind);
3387 my $sth2 = $dbh->prepare("DELETE FROM biblio WHERE biblionumber=?");
3388 $sth2->execute($biblionumber);
3389 # update the timestamp (Bugzilla 7146)
3390 $sth2= $dbh->prepare("UPDATE deletedbiblio SET timestamp=NOW() WHERE biblionumber=?");
3391 $sth2->execute($biblionumber);
3398 =head2 _koha_delete_biblioitems
3400 $error = _koha_delete_biblioitems($dbh,$biblioitemnumber);
3402 Internal sub for deleting from biblioitems table -- also saves to deletedbiblioitems
3404 C<$dbh> - the database handle
3405 C<$biblionumber> - the biblioitemnumber of the biblioitem to be deleted
3409 # FIXME: add error handling
3411 sub _koha_delete_biblioitems {
3412 my ( $dbh, $biblioitemnumber ) = @_;
3414 # get all the data for this biblioitem
3415 my $sth = $dbh->prepare("SELECT * FROM biblioitems WHERE biblioitemnumber=?");
3416 $sth->execute($biblioitemnumber);
3418 if ( my $data = $sth->fetchrow_hashref ) {
3420 # save the record in deletedbiblioitems
3421 # find the fields to save
3422 my $query = "INSERT INTO deletedbiblioitems SET ";
3424 foreach my $temp ( keys %$data ) {
3425 $query .= "$temp = ?,";
3426 push( @bind, $data->{$temp} );
3429 # replace the last , by ",?)"
3431 my $bkup_sth = $dbh->prepare($query);
3432 $bkup_sth->execute(@bind);
3435 # delete the biblioitem
3436 my $sth2 = $dbh->prepare("DELETE FROM biblioitems WHERE biblioitemnumber=?");
3437 $sth2->execute($biblioitemnumber);
3438 # update the timestamp (Bugzilla 7146)
3439 $sth2= $dbh->prepare("UPDATE deletedbiblioitems SET timestamp=NOW() WHERE biblioitemnumber=?");
3440 $sth2->execute($biblioitemnumber);
3447 =head1 UNEXPORTED FUNCTIONS
3449 =head2 ModBiblioMarc
3451 &ModBiblioMarc($newrec,$biblionumber,$frameworkcode);
3453 Add MARC data for a biblio to koha
3455 Function exported, but should NOT be used, unless you really know what you're doing
3461 # pass the MARC::Record to this function, and it will create the records in the marc field
3462 my ( $record, $biblionumber, $frameworkcode ) = @_;
3463 my $dbh = C4::Context->dbh;
3464 my @fields = $record->fields();
3465 if ( !$frameworkcode ) {
3466 $frameworkcode = "";
3468 my $sth = $dbh->prepare("UPDATE biblio SET frameworkcode=? WHERE biblionumber=?");
3469 $sth->execute( $frameworkcode, $biblionumber );
3471 my $encoding = C4::Context->preference("marcflavour");
3473 # deal with UNIMARC field 100 (encoding) : create it if needed & set encoding to unicode
3474 if ( $encoding eq "UNIMARC" ) {
3475 my $string = $record->subfield( 100, "a" );
3476 if ( ($string) && ( length( $record->subfield( 100, "a" ) ) == 36 ) ) {
3477 my $f100 = $record->field(100);
3478 $record->delete_field($f100);
3480 $string = POSIX::strftime( "%Y%m%d", localtime );
3482 $string = sprintf( "%-*s", 35, $string );
3484 substr( $string, 22, 6, "frey50" );
3485 unless ( $record->subfield( 100, "a" ) ) {
3486 $record->insert_fields_ordered( MARC::Field->new( 100, "", "", "a" => $string ) );
3490 #enhancement 5374: update transaction date (005) for marc21/unimarc
3491 if($encoding =~ /MARC21|UNIMARC/) {
3492 my @a= (localtime) [5,4,3,2,1,0]; $a[0]+=1900; $a[1]++;
3493 # YY MM DD HH MM SS (update year and month)
3494 my $f005= $record->field('005');
3495 $f005->update(sprintf("%4d%02d%02d%02d%02d%04.1f",@a)) if $f005;
3499 if ( C4::Context->preference("NoZebra") ) {
3501 # only NoZebra indexing needs to have
3502 # the previous version of the record
3503 $oldRecord = GetMarcBiblio($biblionumber);
3505 $sth = $dbh->prepare("UPDATE biblioitems SET marc=?,marcxml=? WHERE biblionumber=?");
3506 $sth->execute( $record->as_usmarc(), $record->as_xml_record($encoding), $biblionumber );
3508 ModZebra( $biblionumber, "specialUpdate", "biblioserver", $oldRecord, $record );
3509 return $biblionumber;
3512 =head2 get_biblio_authorised_values
3514 find the types and values for all authorised values assigned to this biblio.
3518 MARC::Record of the bib
3520 returns: a hashref mapping the authorised value to the value set for this biblionumber
3522 $authorised_values = {
3523 'Scent' => 'flowery',
3524 'Audience' => 'Young Adult',
3525 'itemtypes' => 'SER',
3528 Notes: forlibrarian should probably be passed in, and called something different.
3532 sub get_biblio_authorised_values {
3533 my $biblionumber = shift;
3536 my $forlibrarian = 1; # are we in staff or opac?
3537 my $frameworkcode = GetFrameworkCode($biblionumber);
3539 my $authorised_values;
3541 my $tagslib = GetMarcStructure( $forlibrarian, $frameworkcode )
3542 or return $authorised_values;
3544 # assume that these entries in the authorised_value table are bibliolevel.
3545 # ones that start with 'item%' are item level.
3546 my $query = q(SELECT distinct authorised_value, kohafield
3547 FROM marc_subfield_structure
3548 WHERE authorised_value !=''
3549 AND (kohafield like 'biblio%'
3550 OR kohafield like '') );
3551 my $bibliolevel_authorised_values = C4::Context->dbh->selectall_hashref( $query, 'authorised_value' );
3553 foreach my $tag ( keys(%$tagslib) ) {
3554 foreach my $subfield ( keys( %{ $tagslib->{$tag} } ) ) {
3556 # warn "checking $subfield. type is: " . ref $tagslib->{ $tag }{ $subfield };
3557 if ( 'HASH' eq ref $tagslib->{$tag}{$subfield} ) {
3558 if ( defined $tagslib->{$tag}{$subfield}{'authorised_value'} && exists $bibliolevel_authorised_values->{ $tagslib->{$tag}{$subfield}{'authorised_value'} } ) {
3559 if ( defined $record->field($tag) ) {
3560 my $this_subfield_value = $record->field($tag)->subfield($subfield);
3561 if ( defined $this_subfield_value ) {
3562 $authorised_values->{ $tagslib->{$tag}{$subfield}{'authorised_value'} } = $this_subfield_value;
3570 # warn ( Data::Dumper->Dump( [ $authorised_values ], [ 'authorised_values' ] ) );
3571 return $authorised_values;
3574 =head2 CountBiblioInOrders
3577 $count = &CountBiblioInOrders( $biblionumber);
3581 This function return count of biblios in orders with $biblionumber
3585 sub CountBiblioInOrders {
3586 my ($biblionumber) = @_;
3587 my $dbh = C4::Context->dbh;
3588 my $query = "SELECT count(*)
3590 WHERE biblionumber=? AND (datecancellationprinted IS NULL OR datecancellationprinted='0000-00-00')";
3591 my $sth = $dbh->prepare($query);
3592 $sth->execute($biblionumber);
3593 my $count = $sth->fetchrow;
3597 =head2 GetSubscriptionsId
3600 $subscriptions = &GetSubscriptionsId($biblionumber);
3604 This function return an array of subscriptionid with $biblionumber
3608 sub GetSubscriptionsId {
3609 my ($biblionumber) = @_;
3610 my $dbh = C4::Context->dbh;
3611 my $query = "SELECT subscriptionid
3613 WHERE biblionumber=?";
3614 my $sth = $dbh->prepare($query);
3615 $sth->execute($biblionumber);
3616 my @subscriptions = $sth->fetchrow_array;
3617 return (@subscriptions);
3623 $holds = &GetHolds($biblionumber);
3627 This function return the count of holds with $biblionumber
3632 my ($biblionumber) = @_;
3633 my $dbh = C4::Context->dbh;
3634 my $query = "SELECT count(*)
3636 WHERE biblionumber=?";
3637 my $sth = $dbh->prepare($query);
3638 $sth->execute($biblionumber);
3639 my $holds = $sth->fetchrow;
3650 Koha Development Team <http://koha-community.org/>
3652 Paul POULAIN paul.poulain@free.fr
3654 Joshua Ferraro jmf@liblime.com