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);
31 use Module::Load::Conditional qw(can_load);
34 use C4::Dates qw/format_date/;
35 use C4::Log; # logaction
41 use vars qw($VERSION @ISA @EXPORT);
44 $VERSION = 3.07.00.049;
47 @ISA = qw( Exporter );
62 &GetBiblioItemByBiblioNumber
63 &GetBiblioFromItemNumber
64 &GetBiblionumberFromItemnumber
90 &GetAuthorisedValueDesc
103 # To modify something
112 # To delete something
117 # To link headings in a bib record
118 # to authority records.
121 &LinkBibHeadingsToAuthorities
125 # those functions are exported but should not be used
126 # they are usefull is few circumstances, so are exported.
127 # but don't use them unless you're a core developer ;-)
135 &TransformHtmlToMarc2
144 if (C4::Context->ismemcached) {
145 require Memoize::Memcached;
146 import Memoize::Memcached qw(memoize_memcached);
148 memoize_memcached( 'GetMarcStructure',
149 memcached => C4::Context->memcached);
155 C4::Biblio - cataloging management functions
159 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:
163 =item 1. in the biblio,biblioitems,items, etc tables, which are limited to a one-to-one mapping to underlying MARC data
165 =item 2. as raw MARC in the Zebra index and storage engine
167 =item 3. as raw MARC the biblioitems.marc and biblioitems.marcxml
171 In the 3.0 version of Koha, the authoritative record-level information is in biblioitems.marcxml
173 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.
177 =item 1. Compared with MySQL, Zebra is slow to update an index for small data changes -- especially for proc-intensive operations like circulation
179 =item 2. Zebra's index has been known to crash and a backup of the data is necessary to rebuild it in such cases
183 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:
187 =item 1. Add*/Mod*/Del*/ - high-level external functions suitable for being called from external scripts to manage the collection
189 =item 2. _koha_* - low-level internal functions for managing the koha tables
191 =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.
193 =item 4. Zebra functions used to update the Zebra index
195 =item 5. internal helper functions such as char_decode, checkitems, etc. Some of these probably belong in Koha.pm
199 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 :
203 =item 1. save datas in biblio and biblioitems table, that gives us a biblionumber and a biblioitemnumber
205 =item 2. add the biblionumber and biblioitemnumber into the MARC records
207 =item 3. save the marc record
211 When dealing with items, we must :
215 =item 1. save the item in items table, that gives us an itemnumber
217 =item 2. add the itemnumber to the item MARC field
219 =item 3. overwrite the MARC record (with the added item) into biblioitems.marc(xml)
221 When modifying a biblio or an item, the behaviour is quite similar.
225 =head1 EXPORTED FUNCTIONS
229 ($biblionumber,$biblioitemnumber) = AddBiblio($record,$frameworkcode);
231 Exported function (core API) for adding a new biblio to koha.
233 The first argument is a C<MARC::Record> object containing the
234 bib to add, while the second argument is the desired MARC
237 This function also accepts a third, optional argument: a hashref
238 to additional options. The only defined option is C<defer_marc_save>,
239 which if present and mapped to a true value, causes C<AddBiblio>
240 to omit the call to save the MARC in C<bibilioitems.marc>
241 and C<biblioitems.marcxml> This option is provided B<only>
242 for the use of scripts such as C<bulkmarcimport.pl> that may need
243 to do some manipulation of the MARC record for item parsing before
244 saving it and which cannot afford the performance hit of saving
245 the MARC record twice. Consequently, do not use that option
246 unless you can guarantee that C<ModBiblioMarc> will be called.
252 my $frameworkcode = shift;
253 my $options = @_ ? shift : undef;
254 my $defer_marc_save = 0;
255 if ( defined $options and exists $options->{'defer_marc_save'} and $options->{'defer_marc_save'} ) {
256 $defer_marc_save = 1;
259 my ( $biblionumber, $biblioitemnumber, $error );
260 my $dbh = C4::Context->dbh;
262 # transform the data into koha-table style data
263 SetUTF8Flag($record);
264 my $olddata = TransformMarcToKoha( $dbh, $record, $frameworkcode );
265 ( $biblionumber, $error ) = _koha_add_biblio( $dbh, $olddata, $frameworkcode );
266 $olddata->{'biblionumber'} = $biblionumber;
267 ( $biblioitemnumber, $error ) = _koha_add_biblioitem( $dbh, $olddata );
269 _koha_marc_update_bib_ids( $record, $frameworkcode, $biblionumber, $biblioitemnumber );
271 # update MARC subfield that stores biblioitems.cn_sort
272 _koha_marc_update_biblioitem_cn_sort( $record, $olddata, $frameworkcode );
275 ModBiblioMarc( $record, $biblionumber, $frameworkcode ) unless $defer_marc_save;
277 # update OAI-PMH sets
278 if(C4::Context->preference("OAI-PMH:AutoUpdateSets")) {
279 C4::OAI::Sets::UpdateOAISetsBiblio($biblionumber, $record);
282 logaction( "CATALOGUING", "ADD", $biblionumber, "biblio" ) if C4::Context->preference("CataloguingLog");
283 return ( $biblionumber, $biblioitemnumber );
288 ModBiblio( $record,$biblionumber,$frameworkcode);
290 Replace an existing bib record identified by C<$biblionumber>
291 with one supplied by the MARC::Record object C<$record>. The embedded
292 item, biblioitem, and biblionumber fields from the previous
293 version of the bib record replace any such fields of those tags that
294 are present in C<$record>. Consequently, ModBiblio() is not
295 to be used to try to modify item records.
297 C<$frameworkcode> specifies the MARC framework to use
298 when storing the modified bib record; among other things,
299 this controls how MARC fields get mapped to display columns
300 in the C<biblio> and C<biblioitems> tables, as well as
301 which fields are used to store embedded item, biblioitem,
302 and biblionumber data for indexing.
307 my ( $record, $biblionumber, $frameworkcode ) = @_;
308 croak "No record" unless $record;
310 if ( C4::Context->preference("CataloguingLog") ) {
311 my $newrecord = GetMarcBiblio($biblionumber);
312 logaction( "CATALOGUING", "MODIFY", $biblionumber, "BEFORE=>" . $newrecord->as_formatted );
315 # Cleaning up invalid fields must be done early or SetUTF8Flag is liable to
316 # throw an exception which probably won't be handled.
317 foreach my $field ($record->fields()) {
318 if (! $field->is_control_field()) {
319 if (scalar($field->subfields()) == 0 || (scalar($field->subfields()) == 1 && $field->subfield('9'))) {
320 $record->delete_field($field);
325 SetUTF8Flag($record);
326 my $dbh = C4::Context->dbh;
328 $frameworkcode = "" if !$frameworkcode || $frameworkcode eq "Default"; # XXX
330 _strip_item_fields($record, $frameworkcode);
332 # update biblionumber and biblioitemnumber in MARC
333 # FIXME - this is assuming a 1 to 1 relationship between
334 # biblios and biblioitems
335 my $sth = $dbh->prepare("select biblioitemnumber from biblioitems where biblionumber=?");
336 $sth->execute($biblionumber);
337 my ($biblioitemnumber) = $sth->fetchrow;
339 _koha_marc_update_bib_ids( $record, $frameworkcode, $biblionumber, $biblioitemnumber );
341 # load the koha-table data object
342 my $oldbiblio = TransformMarcToKoha( $dbh, $record, $frameworkcode );
344 # update MARC subfield that stores biblioitems.cn_sort
345 _koha_marc_update_biblioitem_cn_sort( $record, $oldbiblio, $frameworkcode );
347 # update the MARC record (that now contains biblio and items) with the new record data
348 &ModBiblioMarc( $record, $biblionumber, $frameworkcode );
350 # modify the other koha tables
351 _koha_modify_biblio( $dbh, $oldbiblio, $frameworkcode );
352 _koha_modify_biblioitem_nonmarc( $dbh, $oldbiblio );
354 # update OAI-PMH sets
355 if(C4::Context->preference("OAI-PMH:AutoUpdateSets")) {
356 C4::OAI::Sets::UpdateOAISetsBiblio($biblionumber, $record);
362 =head2 _strip_item_fields
364 _strip_item_fields($record, $frameworkcode)
366 Utility routine to remove item tags from a
371 sub _strip_item_fields {
373 my $frameworkcode = shift;
374 # get the items before and append them to the biblio before updating the record, atm we just have the biblio
375 my ( $itemtag, $itemsubfield ) = GetMarcFromKohaField( "items.itemnumber", $frameworkcode );
377 # delete any item fields from incoming record to avoid
378 # duplication or incorrect data - use AddItem() or ModItem()
380 foreach my $field ( $record->field($itemtag) ) {
381 $record->delete_field($field);
385 =head2 ModBiblioframework
387 ModBiblioframework($biblionumber,$frameworkcode);
389 Exported function to modify a biblio framework
393 sub ModBiblioframework {
394 my ( $biblionumber, $frameworkcode ) = @_;
395 my $dbh = C4::Context->dbh;
396 my $sth = $dbh->prepare( "UPDATE biblio SET frameworkcode=? WHERE biblionumber=?" );
397 $sth->execute( $frameworkcode, $biblionumber );
403 my $error = &DelBiblio($biblionumber);
405 Exported function (core API) for deleting a biblio in koha.
406 Deletes biblio record from Zebra and Koha tables (biblio,biblioitems,items)
407 Also backs it up to deleted* tables
408 Checks to make sure there are not issues on any of the items
410 C<$error> : undef unless an error occurs
415 my ($biblionumber) = @_;
416 my $dbh = C4::Context->dbh;
417 my $error; # for error handling
419 # First make sure this biblio has no items attached
420 my $sth = $dbh->prepare("SELECT itemnumber FROM items WHERE biblionumber=?");
421 $sth->execute($biblionumber);
422 if ( my $itemnumber = $sth->fetchrow ) {
424 # Fix this to use a status the template can understand
425 $error .= "This Biblio has items attached, please delete them first before deleting this biblio ";
428 return $error if $error;
430 # We delete attached subscriptions
432 my $subscriptions = C4::Serials::GetFullSubscriptionsFromBiblionumber($biblionumber);
433 foreach my $subscription (@$subscriptions) {
434 C4::Serials::DelSubscription( $subscription->{subscriptionid} );
437 # We delete any existing holds
438 require C4::Reserves;
439 my ($count, $reserves) = C4::Reserves::GetReservesFromBiblionumber($biblionumber);
440 foreach my $res ( @$reserves ) {
441 C4::Reserves::CancelReserve( $res->{'biblionumber'}, $res->{'itemnumber'}, $res->{'borrowernumber'} );
444 # Delete in Zebra. Be careful NOT to move this line after _koha_delete_biblio
445 # for at least 2 reasons :
446 # - we need to read the biblio if NoZebra is set (to remove it from the indexes
447 # - if something goes wrong, the biblio may be deleted from Koha but not from zebra
448 # 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)
450 if ( C4::Context->preference("NoZebra") ) {
452 # only NoZebra indexing needs to have
453 # the previous version of the record
454 $oldRecord = GetMarcBiblio($biblionumber);
456 ModZebra( $biblionumber, "recordDelete", "biblioserver", $oldRecord, undef );
458 # delete biblioitems and items from Koha tables and save in deletedbiblioitems,deleteditems
459 $sth = $dbh->prepare("SELECT biblioitemnumber FROM biblioitems WHERE biblionumber=?");
460 $sth->execute($biblionumber);
461 while ( my $biblioitemnumber = $sth->fetchrow ) {
463 # delete this biblioitem
464 $error = _koha_delete_biblioitems( $dbh, $biblioitemnumber );
465 return $error if $error;
468 # delete biblio from Koha tables and save in deletedbiblio
469 # must do this *after* _koha_delete_biblioitems, otherwise
470 # delete cascade will prevent deletedbiblioitems rows
471 # from being generated by _koha_delete_biblioitems
472 $error = _koha_delete_biblio( $dbh, $biblionumber );
474 logaction( "CATALOGUING", "DELETE", $biblionumber, "" ) if C4::Context->preference("CataloguingLog");
480 =head2 BiblioAutoLink
482 my $headings_linked = BiblioAutoLink($record, $frameworkcode)
484 Automatically links headings in a bib record to authorities.
490 my $frameworkcode = shift;
491 my ( $num_headings_changed, %results );
494 "C4::Linker::" . ( C4::Context->preference("LinkerModule") || 'Default' );
495 unless ( can_load( modules => { $linker_module => undef } ) ) {
496 $linker_module = 'C4::Linker::Default';
497 unless ( can_load( modules => { $linker_module => undef } ) ) {
502 my $linker = $linker_module->new(
503 { 'options' => C4::Context->preference("LinkerOptions") } );
504 my ( $headings_changed, undef ) =
505 LinkBibHeadingsToAuthorities( $linker, $record, $frameworkcode, C4::Context->preference("CatalogModuleRelink") || '' );
506 # By default we probably don't want to relink things when cataloging
507 return $headings_changed;
510 =head2 LinkBibHeadingsToAuthorities
512 my $num_headings_changed, %results = LinkBibHeadingsToAuthorities($linker, $marc, $frameworkcode, [$allowrelink]);
514 Links bib headings to authority records by checking
515 each authority-controlled field in the C<MARC::Record>
516 object C<$marc>, looking for a matching authority record,
517 and setting the linking subfield $9 to the ID of that
520 If $allowrelink is false, existing authids will never be
521 replaced, regardless of the values of LinkerKeepStale and
524 Returns the number of heading links changed in the
529 sub LinkBibHeadingsToAuthorities {
532 my $frameworkcode = shift;
533 my $allowrelink = shift;
536 require C4::AuthoritiesMarc;
538 $allowrelink = 1 unless defined $allowrelink;
539 my $num_headings_changed = 0;
540 foreach my $field ( $bib->fields() ) {
541 my $heading = C4::Heading->new_from_bib_field( $field, $frameworkcode );
542 next unless defined $heading;
545 my $current_link = $field->subfield('9');
547 if ( defined $current_link && (!$allowrelink || !C4::Context->preference('LinkerRelink')) )
549 $results{'linked'}->{ $heading->display_form() }++;
553 my ( $authid, $fuzzy ) = $linker->get_link($heading);
555 $results{ $fuzzy ? 'fuzzy' : 'linked' }
556 ->{ $heading->display_form() }++;
557 next if defined $current_link and $current_link == $authid;
559 $field->delete_subfield( code => '9' ) if defined $current_link;
560 $field->add_subfields( '9', $authid );
561 $num_headings_changed++;
564 if ( defined $current_link
565 && (!$allowrelink || C4::Context->preference('LinkerKeepStale')) )
567 $results{'fuzzy'}->{ $heading->display_form() }++;
569 elsif ( C4::Context->preference('AutoCreateAuthorities') ) {
570 if ( _check_valid_auth_link( $current_link, $field ) ) {
571 $results{'linked'}->{ $heading->display_form() }++;
575 C4::AuthoritiesMarc::GetAuthType( $heading->auth_type() );
576 my $marcrecordauth = MARC::Record->new();
577 if ( C4::Context->preference('marcflavour') eq 'MARC21' ) {
578 $marcrecordauth->leader(' nz a22 o 4500');
579 SetMarcUnicodeFlag( $marcrecordauth, 'MARC21' );
581 $field->delete_subfield( code => '9' )
582 if defined $current_link;
584 MARC::Field->new( $authtypedata->{auth_tag_to_report},
585 '', '', "a" => "" . $field->subfield('a') );
587 $authfield->add_subfields( $_->[0] => $_->[1] )
588 if ( $_->[0] =~ /[A-z]/ && $_->[0] ne "a" )
589 } $field->subfields();
590 $marcrecordauth->insert_fields_ordered($authfield);
592 # bug 2317: ensure new authority knows it's using UTF-8; currently
593 # only need to do this for MARC21, as MARC::Record->as_xml_record() handles
594 # automatically for UNIMARC (by not transcoding)
595 # FIXME: AddAuthority() instead should simply explicitly require that the MARC::Record
596 # use UTF-8, but as of 2008-08-05, did not want to introduce that kind
597 # of change to a core API just before the 3.0 release.
599 if ( C4::Context->preference('marcflavour') eq 'MARC21' ) {
600 $marcrecordauth->insert_fields_ordered(
603 'a' => "Machine generated authority record."
607 $bib->author() . ", "
608 . $bib->title_proper() . ", "
609 . $bib->publication_date() . " ";
610 $cite =~ s/^[\s\,]*//;
611 $cite =~ s/[\s\,]*$//;
614 . C4::Context->preference('MARCOrgCode') . ")"
615 . $bib->subfield( '999', 'c' ) . ": "
617 $marcrecordauth->insert_fields_ordered(
618 MARC::Field->new( '670', '', '', 'a' => $cite ) );
621 # warn "AUTH RECORD ADDED : ".$marcrecordauth->as_formatted;
624 C4::AuthoritiesMarc::AddAuthority( $marcrecordauth, '',
625 $heading->auth_type() );
626 $field->add_subfields( '9', $authid );
627 $num_headings_changed++;
628 $results{'added'}->{ $heading->display_form() }++;
631 elsif ( defined $current_link ) {
632 if ( _check_valid_auth_link( $current_link, $field ) ) {
633 $results{'linked'}->{ $heading->display_form() }++;
636 $field->delete_subfield( code => '9' );
637 $num_headings_changed++;
638 $results{'unlinked'}->{ $heading->display_form() }++;
642 $results{'unlinked'}->{ $heading->display_form() }++;
647 return $num_headings_changed, \%results;
650 =head2 _check_valid_auth_link
652 if ( _check_valid_auth_link($authid, $field) ) {
656 Check whether the specified heading-auth link is valid without reference
657 to Zebra/Solr. Ideally this code would be in C4::Heading, but that won't be
658 possible until we have de-cycled C4::AuthoritiesMarc, so this is the
663 sub _check_valid_auth_link {
664 my ( $authid, $field ) = @_;
666 require C4::AuthoritiesMarc;
668 my $authorized_heading =
669 C4::AuthoritiesMarc::GetAuthorizedHeading( { 'authid' => $authid } );
671 return ($field->as_string('abcdefghijklmnopqrstuvwxyz') eq $authorized_heading);
674 =head2 GetRecordValue
676 my $values = GetRecordValue($field, $record, $frameworkcode);
678 Get MARC fields from a keyword defined in fieldmapping table.
683 my ( $field, $record, $frameworkcode ) = @_;
684 my $dbh = C4::Context->dbh;
686 my $sth = $dbh->prepare('SELECT fieldcode, subfieldcode FROM fieldmapping WHERE frameworkcode = ? AND field = ?');
687 $sth->execute( $frameworkcode, $field );
691 while ( my $row = $sth->fetchrow_hashref ) {
692 foreach my $field ( $record->field( $row->{fieldcode} ) ) {
693 if ( ( $row->{subfieldcode} ne "" && $field->subfield( $row->{subfieldcode} ) ) ) {
694 foreach my $subfield ( $field->subfield( $row->{subfieldcode} ) ) {
695 push @result, { 'subfield' => $subfield };
698 } elsif ( $row->{subfieldcode} eq "" ) {
699 push @result, { 'subfield' => $field->as_string() };
707 =head2 SetFieldMapping
709 SetFieldMapping($framework, $field, $fieldcode, $subfieldcode);
711 Set a Field to MARC mapping value, if it already exists we don't add a new one.
715 sub SetFieldMapping {
716 my ( $framework, $field, $fieldcode, $subfieldcode ) = @_;
717 my $dbh = C4::Context->dbh;
719 my $sth = $dbh->prepare('SELECT * FROM fieldmapping WHERE fieldcode = ? AND subfieldcode = ? AND frameworkcode = ? AND field = ?');
720 $sth->execute( $fieldcode, $subfieldcode, $framework, $field );
721 if ( not $sth->fetchrow_hashref ) {
723 $sth = $dbh->prepare('INSERT INTO fieldmapping (fieldcode, subfieldcode, frameworkcode, field) VALUES(?,?,?,?)');
725 $sth->execute( $fieldcode, $subfieldcode, $framework, $field );
729 =head2 DeleteFieldMapping
731 DeleteFieldMapping($id);
733 Delete a field mapping from an $id.
737 sub DeleteFieldMapping {
739 my $dbh = C4::Context->dbh;
741 my $sth = $dbh->prepare('DELETE FROM fieldmapping WHERE id = ?');
745 =head2 GetFieldMapping
747 GetFieldMapping($frameworkcode);
749 Get all field mappings for a specified frameworkcode
753 sub GetFieldMapping {
754 my ($framework) = @_;
755 my $dbh = C4::Context->dbh;
757 my $sth = $dbh->prepare('SELECT * FROM fieldmapping where frameworkcode = ?');
758 $sth->execute($framework);
761 while ( my $row = $sth->fetchrow_hashref ) {
769 $data = &GetBiblioData($biblionumber);
771 Returns information about the book with the given biblionumber.
772 C<&GetBiblioData> returns a reference-to-hash. The keys are the fields in
773 the C<biblio> and C<biblioitems> tables in the
776 In addition, C<$data-E<gt>{subject}> is the list of the book's
777 subjects, separated by C<" , "> (space, comma, space).
778 If there are multiple biblioitems with the given biblionumber, only
779 the first one is considered.
785 my $dbh = C4::Context->dbh;
787 # my $query = C4::Context->preference('item-level_itypes') ?
788 # " SELECT * , biblioitems.notes AS bnotes, biblio.notes
790 # LEFT JOIN biblioitems ON biblio.biblionumber = biblioitems.biblionumber
791 # WHERE biblio.biblionumber = ?
792 # AND biblioitems.biblionumber = biblio.biblionumber
795 my $query = " SELECT * , biblioitems.notes AS bnotes, itemtypes.notforloan as bi_notforloan, biblio.notes
797 LEFT JOIN biblioitems ON biblio.biblionumber = biblioitems.biblionumber
798 LEFT JOIN itemtypes ON biblioitems.itemtype = itemtypes.itemtype
799 WHERE biblio.biblionumber = ?
800 AND biblioitems.biblionumber = biblio.biblionumber ";
802 my $sth = $dbh->prepare($query);
803 $sth->execute($bibnum);
805 $data = $sth->fetchrow_hashref;
809 } # sub GetBiblioData
811 =head2 &GetBiblioItemData
813 $itemdata = &GetBiblioItemData($biblioitemnumber);
815 Looks up the biblioitem with the given biblioitemnumber. Returns a
816 reference-to-hash. The keys are the fields from the C<biblio>,
817 C<biblioitems>, and C<itemtypes> tables in the Koha database, except
818 that C<biblioitems.notes> is given as C<$itemdata-E<gt>{bnotes}>.
823 sub GetBiblioItemData {
824 my ($biblioitemnumber) = @_;
825 my $dbh = C4::Context->dbh;
826 my $query = "SELECT *,biblioitems.notes AS bnotes
827 FROM biblio LEFT JOIN biblioitems on biblio.biblionumber=biblioitems.biblionumber ";
828 unless ( C4::Context->preference('item-level_itypes') ) {
829 $query .= "LEFT JOIN itemtypes on biblioitems.itemtype=itemtypes.itemtype ";
831 $query .= " WHERE biblioitemnumber = ? ";
832 my $sth = $dbh->prepare($query);
834 $sth->execute($biblioitemnumber);
835 $data = $sth->fetchrow_hashref;
838 } # sub &GetBiblioItemData
840 =head2 GetBiblioItemByBiblioNumber
842 NOTE : This function has been copy/paste from C4/Biblio.pm from head before zebra integration.
846 sub GetBiblioItemByBiblioNumber {
847 my ($biblionumber) = @_;
848 my $dbh = C4::Context->dbh;
849 my $sth = $dbh->prepare("Select * FROM biblioitems WHERE biblionumber = ?");
853 $sth->execute($biblionumber);
855 while ( my $data = $sth->fetchrow_hashref ) {
856 push @results, $data;
863 =head2 GetBiblionumberFromItemnumber
868 sub GetBiblionumberFromItemnumber {
869 my ($itemnumber) = @_;
870 my $dbh = C4::Context->dbh;
871 my $sth = $dbh->prepare("Select biblionumber FROM items WHERE itemnumber = ?");
873 $sth->execute($itemnumber);
874 my ($result) = $sth->fetchrow;
878 =head2 GetBiblioFromItemNumber
880 $item = &GetBiblioFromItemNumber($itemnumber,$barcode);
882 Looks up the item with the given itemnumber. if undef, try the barcode.
884 C<&itemnodata> returns a reference-to-hash whose keys are the fields
885 from the C<biblio>, C<biblioitems>, and C<items> tables in the Koha
891 sub GetBiblioFromItemNumber {
892 my ( $itemnumber, $barcode ) = @_;
893 my $dbh = C4::Context->dbh;
896 $sth = $dbh->prepare(
898 LEFT JOIN biblio ON biblio.biblionumber = items.biblionumber
899 LEFT JOIN biblioitems ON biblioitems.biblioitemnumber = items.biblioitemnumber
900 WHERE items.itemnumber = ?"
902 $sth->execute($itemnumber);
904 $sth = $dbh->prepare(
906 LEFT JOIN biblio ON biblio.biblionumber = items.biblionumber
907 LEFT JOIN biblioitems ON biblioitems.biblioitemnumber = items.biblioitemnumber
908 WHERE items.barcode = ?"
910 $sth->execute($barcode);
912 my $data = $sth->fetchrow_hashref;
919 $isbd = &GetISBDView($biblionumber);
921 Return the ISBD view which can be included in opac and intranet
926 my ( $biblionumber, $template ) = @_;
927 my $record = GetMarcBiblio($biblionumber, 1);
928 return unless defined $record;
929 my $itemtype = &GetFrameworkCode($biblionumber);
930 my ( $holdingbrtagf, $holdingbrtagsubf ) = &GetMarcFromKohaField( "items.holdingbranch", $itemtype );
931 my $tagslib = &GetMarcStructure( 1, $itemtype );
933 my $ISBD = C4::Context->preference('isbd');
938 foreach my $isbdfield ( split( /#/, $bloc ) ) {
940 # $isbdfield= /(.?.?.?)/;
941 $isbdfield =~ /(\d\d\d)([^\|])?\|(.*)\|(.*)\|(.*)/;
942 my $fieldvalue = $1 || 0;
943 my $subfvalue = $2 || "";
945 my $analysestring = $4;
948 # warn "==> $1 / $2 / $3 / $4";
949 # my $fieldvalue=substr($isbdfield,0,3);
950 if ( $fieldvalue > 0 ) {
951 my $hasputtextbefore = 0;
952 my @fieldslist = $record->field($fieldvalue);
953 @fieldslist = sort { $a->subfield($holdingbrtagsubf) cmp $b->subfield($holdingbrtagsubf) } @fieldslist if ( $fieldvalue eq $holdingbrtagf );
955 # warn "ERROR IN ISBD DEFINITION at : $isbdfield" unless $fieldvalue;
956 # warn "FV : $fieldvalue";
957 if ( $subfvalue ne "" ) {
958 foreach my $field (@fieldslist) {
959 foreach my $subfield ( $field->subfield($subfvalue) ) {
960 my $calculated = $analysestring;
961 my $tag = $field->tag();
964 my $subfieldvalue = GetAuthorisedValueDesc( $tag, $subfvalue, $subfield, '', $tagslib );
965 my $tagsubf = $tag . $subfvalue;
966 $calculated =~ s/\{(.?.?.?.?)$tagsubf(.*?)\}/$1$subfieldvalue$2\{$1$tagsubf$2\}/g;
967 if ( $template eq "opac" ) { $calculated =~ s#/cgi-bin/koha/[^/]+/([^.]*.pl\?.*)$#opac-$1#g; }
969 # field builded, store the result
970 if ( $calculated && !$hasputtextbefore ) { # put textbefore if not done
971 $blocres .= $textbefore;
972 $hasputtextbefore = 1;
975 # remove punctuation at start
976 $calculated =~ s/^( |;|:|\.|-)*//g;
977 $blocres .= $calculated;
982 $blocres .= $textafter if $hasputtextbefore;
984 foreach my $field (@fieldslist) {
985 my $calculated = $analysestring;
986 my $tag = $field->tag();
989 my @subf = $field->subfields;
990 for my $i ( 0 .. $#subf ) {
991 my $valuecode = $subf[$i][1];
992 my $subfieldcode = $subf[$i][0];
993 my $subfieldvalue = GetAuthorisedValueDesc( $tag, $subf[$i][0], $subf[$i][1], '', $tagslib );
994 my $tagsubf = $tag . $subfieldcode;
996 $calculated =~ s/ # replace all {{}} codes by the value code.
997 \{\{$tagsubf\}\} # catch the {{actualcode}}
999 $valuecode # replace by the value code
1002 $calculated =~ s/\{(.?.?.?.?)$tagsubf(.*?)\}/$1$subfieldvalue$2\{$1$tagsubf$2\}/g;
1003 if ( $template eq "opac" ) { $calculated =~ s#/cgi-bin/koha/[^/]+/([^.]*.pl\?.*)$#opac-$1#g; }
1006 # field builded, store the result
1007 if ( $calculated && !$hasputtextbefore ) { # put textbefore if not done
1008 $blocres .= $textbefore;
1009 $hasputtextbefore = 1;
1012 # remove punctuation at start
1013 $calculated =~ s/^( |;|:|\.|-)*//g;
1014 $blocres .= $calculated;
1017 $blocres .= $textafter if $hasputtextbefore;
1020 $blocres .= $isbdfield;
1025 $res =~ s/\{(.*?)\}//g;
1027 $res =~ s/\n/<br\/>/g;
1037 my $biblio = &GetBiblio($biblionumber);
1042 my ($biblionumber) = @_;
1043 my $dbh = C4::Context->dbh;
1044 my $sth = $dbh->prepare("SELECT * FROM biblio WHERE biblionumber = ?");
1047 $sth->execute($biblionumber);
1048 if ( my $data = $sth->fetchrow_hashref ) {
1054 =head2 GetBiblioItemInfosOf
1056 GetBiblioItemInfosOf(@biblioitemnumbers);
1060 sub GetBiblioItemInfosOf {
1061 my @biblioitemnumbers = @_;
1064 SELECT biblioitemnumber,
1068 WHERE biblioitemnumber IN (' . join( ',', @biblioitemnumbers ) . ')
1070 return get_infos_of( $query, 'biblioitemnumber' );
1073 =head1 FUNCTIONS FOR HANDLING MARC MANAGEMENT
1075 =head2 GetMarcStructure
1077 $res = GetMarcStructure($forlibrarian,$frameworkcode);
1079 Returns a reference to a big hash of hash, with the Marc structure for the given frameworkcode
1080 $forlibrarian :if set to 1, the MARC descriptions are the librarians ones, otherwise it's the public (OPAC) ones
1081 $frameworkcode : the framework code to read
1085 # cache for results of GetMarcStructure -- needed
1087 our $marc_structure_cache;
1089 sub GetMarcStructure {
1090 my ( $forlibrarian, $frameworkcode ) = @_;
1091 my $dbh = C4::Context->dbh;
1092 $frameworkcode = "" unless $frameworkcode;
1094 if ( defined $marc_structure_cache and exists $marc_structure_cache->{$forlibrarian}->{$frameworkcode} ) {
1095 return $marc_structure_cache->{$forlibrarian}->{$frameworkcode};
1098 # my $sth = $dbh->prepare(
1099 # "SELECT COUNT(*) FROM marc_tag_structure WHERE frameworkcode=?");
1100 # $sth->execute($frameworkcode);
1101 # my ($total) = $sth->fetchrow;
1102 # $frameworkcode = "" unless ( $total > 0 );
1103 my $sth = $dbh->prepare(
1104 "SELECT tagfield,liblibrarian,libopac,mandatory,repeatable
1105 FROM marc_tag_structure
1106 WHERE frameworkcode=?
1109 $sth->execute($frameworkcode);
1110 my ( $liblibrarian, $libopac, $tag, $res, $tab, $mandatory, $repeatable );
1112 while ( ( $tag, $liblibrarian, $libopac, $mandatory, $repeatable ) = $sth->fetchrow ) {
1113 $res->{$tag}->{lib} = ( $forlibrarian or !$libopac ) ? $liblibrarian : $libopac;
1114 $res->{$tag}->{tab} = "";
1115 $res->{$tag}->{mandatory} = $mandatory;
1116 $res->{$tag}->{repeatable} = $repeatable;
1119 $sth = $dbh->prepare(
1120 "SELECT tagfield,tagsubfield,liblibrarian,libopac,tab,mandatory,repeatable,authorised_value,authtypecode,value_builder,kohafield,seealso,hidden,isurl,link,defaultvalue,maxlength
1121 FROM marc_subfield_structure
1122 WHERE frameworkcode=?
1123 ORDER BY tagfield,tagsubfield
1127 $sth->execute($frameworkcode);
1130 my $authorised_value;
1142 ( $tag, $subfield, $liblibrarian, $libopac, $tab, $mandatory, $repeatable, $authorised_value,
1143 $authtypecode, $value_builder, $kohafield, $seealso, $hidden, $isurl, $link, $defaultvalue,
1148 $res->{$tag}->{$subfield}->{lib} = ( $forlibrarian or !$libopac ) ? $liblibrarian : $libopac;
1149 $res->{$tag}->{$subfield}->{tab} = $tab;
1150 $res->{$tag}->{$subfield}->{mandatory} = $mandatory;
1151 $res->{$tag}->{$subfield}->{repeatable} = $repeatable;
1152 $res->{$tag}->{$subfield}->{authorised_value} = $authorised_value;
1153 $res->{$tag}->{$subfield}->{authtypecode} = $authtypecode;
1154 $res->{$tag}->{$subfield}->{value_builder} = $value_builder;
1155 $res->{$tag}->{$subfield}->{kohafield} = $kohafield;
1156 $res->{$tag}->{$subfield}->{seealso} = $seealso;
1157 $res->{$tag}->{$subfield}->{hidden} = $hidden;
1158 $res->{$tag}->{$subfield}->{isurl} = $isurl;
1159 $res->{$tag}->{$subfield}->{'link'} = $link;
1160 $res->{$tag}->{$subfield}->{defaultvalue} = $defaultvalue;
1161 $res->{$tag}->{$subfield}->{maxlength} = $maxlength;
1164 $marc_structure_cache->{$forlibrarian}->{$frameworkcode} = $res;
1169 =head2 GetUsedMarcStructure
1171 The same function as GetMarcStructure except it just takes field
1172 in tab 0-9. (used field)
1174 my $results = GetUsedMarcStructure($frameworkcode);
1176 C<$results> is a ref to an array which each case containts a ref
1177 to a hash which each keys is the columns from marc_subfield_structure
1179 C<$frameworkcode> is the framework code.
1183 sub GetUsedMarcStructure {
1184 my $frameworkcode = shift || '';
1187 FROM marc_subfield_structure
1189 AND frameworkcode = ?
1190 ORDER BY tagfield, tagsubfield
1192 my $sth = C4::Context->dbh->prepare($query);
1193 $sth->execute($frameworkcode);
1194 return $sth->fetchall_arrayref( {} );
1197 =head2 GetMarcFromKohaField
1199 ($MARCfield,$MARCsubfield)=GetMarcFromKohaField($kohafield,$frameworkcode);
1201 Returns the MARC fields & subfields mapped to the koha field
1202 for the given frameworkcode or default framework if $frameworkcode is missing
1206 sub GetMarcFromKohaField {
1207 my $kohafield = shift;
1208 my $frameworkcode = shift || '';
1209 return (0, undef) unless $kohafield;
1210 my $relations = C4::Context->marcfromkohafield;
1211 if ( my $mf = $relations->{$frameworkcode}->{$kohafield} ) {
1217 =head2 GetMarcBiblio
1219 my $record = GetMarcBiblio($biblionumber, [$embeditems]);
1221 Returns MARC::Record representing bib identified by
1222 C<$biblionumber>. If no bib exists, returns undef.
1223 C<$embeditems>. If set to true, items data are included.
1224 The MARC record contains biblio data, and items data if $embeditems is set to true.
1229 my $biblionumber = shift;
1230 my $embeditems = shift || 0;
1231 my $dbh = C4::Context->dbh;
1232 my $sth = $dbh->prepare("SELECT marcxml FROM biblioitems WHERE biblionumber=? ");
1233 $sth->execute($biblionumber);
1234 my $row = $sth->fetchrow_hashref;
1235 my $marcxml = StripNonXmlChars( $row->{'marcxml'} );
1236 MARC::File::XML->default_record_format( C4::Context->preference('marcflavour') );
1237 my $record = MARC::Record->new();
1240 $record = eval { MARC::Record::new_from_xml( $marcxml, "utf8", C4::Context->preference('marcflavour') ) };
1241 if ($@) { warn " problem with :$biblionumber : $@ \n$marcxml"; }
1242 return unless $record;
1244 C4::Biblio::_koha_marc_update_bib_ids($record, '', $biblionumber, $biblionumber);
1245 C4::Biblio::EmbedItemsInMarcBiblio($record, $biblionumber) if ($embeditems);
1255 my $marcxml = GetXmlBiblio($biblionumber);
1257 Returns biblioitems.marcxml of the biblionumber passed in parameter.
1258 The XML contains both biblio & item datas
1263 my ($biblionumber) = @_;
1264 my $dbh = C4::Context->dbh;
1265 my $sth = $dbh->prepare("SELECT marcxml FROM biblioitems WHERE biblionumber=? ");
1266 $sth->execute($biblionumber);
1267 my ($marcxml) = $sth->fetchrow;
1271 =head2 GetCOinSBiblio
1273 my $coins = GetCOinSBiblio($record);
1275 Returns the COinS (a span) which can be included in a biblio record
1279 sub GetCOinSBiblio {
1282 # get the coin format
1286 my $pos7 = substr $record->leader(), 7, 1;
1287 my $pos6 = substr $record->leader(), 6, 1;
1290 my ( $aulast, $aufirst ) = ( '', '' );
1299 my $titletype = 'b';
1301 # For the purposes of generating COinS metadata, LDR/06-07 can be
1302 # considered the same for UNIMARC and MARC21
1307 'b' => 'manuscript',
1309 'd' => 'manuscript',
1313 'i' => 'audioRecording',
1314 'j' => 'audioRecording',
1317 'm' => 'computerProgram',
1322 'a' => 'journalArticle',
1326 $genre = $fmts6->{$pos6} ? $fmts6->{$pos6} : 'book';
1328 if ( $genre eq 'book' ) {
1329 $genre = $fmts7->{$pos7} if $fmts7->{$pos7};
1332 ##### We must transform mtx to a valable mtx and document type ####
1333 if ( $genre eq 'book' ) {
1335 } elsif ( $genre eq 'journal' ) {
1338 } elsif ( $genre eq 'journalArticle' ) {
1346 $genre = ( $mtx eq 'dc' ) ? "&rft.type=$genre" : "&rft.genre=$genre";
1348 if ( C4::Context->preference("marcflavour") eq "UNIMARC" ) {
1351 $aulast = $record->subfield( '700', 'a' ) || '';
1352 $aufirst = $record->subfield( '700', 'b' ) || '';
1353 $oauthors = "&rft.au=$aufirst $aulast";
1356 if ( $record->field('200') ) {
1357 for my $au ( $record->field('200')->subfield('g') ) {
1358 $oauthors .= "&rft.au=$au";
1363 ? "&rft.title=" . $record->subfield( '200', 'a' )
1364 : "&rft.title=" . $record->subfield( '200', 'a' ) . "&rft.btitle=" . $record->subfield( '200', 'a' );
1365 $pubyear = $record->subfield( '210', 'd' ) || '';
1366 $publisher = $record->subfield( '210', 'c' ) || '';
1367 $isbn = $record->subfield( '010', 'a' ) || '';
1368 $issn = $record->subfield( '011', 'a' ) || '';
1371 # MARC21 need some improve
1374 if ( $record->field('100') ) {
1375 $oauthors .= "&rft.au=" . $record->subfield( '100', 'a' );
1379 if ( $record->field('700') ) {
1380 for my $au ( $record->field('700')->subfield('a') ) {
1381 $oauthors .= "&rft.au=$au";
1384 $title = "&rft." . $titletype . "title=" . $record->subfield( '245', 'a' );
1385 $subtitle = $record->subfield( '245', 'b' ) || '';
1386 $title .= $subtitle;
1387 if ($titletype eq 'a') {
1388 $pubyear = $record->field('008') || '';
1389 $pubyear = substr($pubyear->data(), 7, 4) if $pubyear;
1390 $isbn = $record->subfield( '773', 'z' ) || '';
1391 $issn = $record->subfield( '773', 'x' ) || '';
1392 if ($mtx eq 'journal') {
1393 $title .= "&rft.title=" . (($record->subfield( '773', 't' ) || $record->subfield( '773', 'a')));
1395 $title .= "&rft.btitle=" . (($record->subfield( '773', 't' ) || $record->subfield( '773', 'a')) || '');
1397 foreach my $rel ($record->subfield( '773', 'g' )) {
1404 $pubyear = $record->subfield( '260', 'c' ) || '';
1405 $publisher = $record->subfield( '260', 'b' ) || '';
1406 $isbn = $record->subfield( '020', 'a' ) || '';
1407 $issn = $record->subfield( '022', 'a' ) || '';
1412 "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";
1413 $coins_value =~ s/(\ |&[^a])/\+/g;
1414 $coins_value =~ s/\"/\"\;/g;
1416 #<!-- 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="
1418 return $coins_value;
1424 return the prices in accordance with the Marc format.
1428 my ( $record, $marcflavour ) = @_;
1432 if ( $marcflavour eq "MARC21" ) {
1433 @listtags = ('345', '020');
1435 } elsif ( $marcflavour eq "UNIMARC" ) {
1436 @listtags = ('345', '010');
1442 for my $field ( $record->field(@listtags) ) {
1443 for my $subfield_value ($field->subfield($subfield)){
1445 $subfield_value = MungeMarcPrice( $subfield_value );
1446 return $subfield_value if ($subfield_value);
1449 return 0; # no price found
1452 =head2 MungeMarcPrice
1454 Return the best guess at what the actual price is from a price field.
1457 sub MungeMarcPrice {
1460 return unless ( $price =~ m/\d/ ); ## No digits means no price.
1462 ## Look for the currency symbol of the active currency, if it's there,
1463 ## start the price string right after the symbol. This allows us to prefer
1464 ## this native currency price over other currency prices, if possible.
1465 my $active_currency = C4::Context->dbh->selectrow_hashref( 'SELECT * FROM currency WHERE active = 1', {} );
1466 my $symbol = quotemeta( $active_currency->{'symbol'} );
1467 if ( $price =~ m/$symbol/ ) {
1468 my @parts = split(/$symbol/, $price );
1472 ## Grab the first number in the string ( can use commas or periods for thousands separator and/or decimal separator )
1473 ( $price ) = $price =~ m/([\d\,\.]+[[\,\.]\d\d]?)/;
1475 ## Split price into array on periods and commas
1476 my @parts = split(/[\,\.]/, $price);
1478 ## If the last grouping of digits is more than 2 characters, assume there is no decimal value and put it back.
1479 my $decimal = pop( @parts );
1480 if ( length( $decimal ) > 2 ) {
1481 push( @parts, $decimal );
1485 $price = join('', @parts );
1488 $price .= ".$decimal";
1495 =head2 GetMarcQuantity
1497 return the quantity of a book. Used in acquisition only, when importing a file an iso2709 from a bookseller
1498 Warning : this is not really in the marc standard. In Unimarc, Electre (the most widely used bookseller) use the 969$a
1502 sub GetMarcQuantity {
1503 my ( $record, $marcflavour ) = @_;
1507 if ( $marcflavour eq "MARC21" ) {
1509 } elsif ( $marcflavour eq "UNIMARC" ) {
1510 @listtags = ('969');
1516 for my $field ( $record->field(@listtags) ) {
1517 for my $subfield_value ($field->subfield($subfield)){
1519 if ($subfield_value) {
1520 # in France, the cents separator is the , but sometimes, ppl use a .
1521 # in this case, the price will be x100 when unformatted ! Replace the . by a , to get a proper price calculation
1522 $subfield_value =~ s/\./,/ if C4::Context->preference("CurrencyFormat") eq "FR";
1523 return $subfield_value;
1527 return 0; # no price found
1531 =head2 GetAuthorisedValueDesc
1533 my $subfieldvalue =get_authorised_value_desc(
1534 $tag, $subf[$i][0],$subf[$i][1], '', $taglib, $category, $opac);
1536 Retrieve the complete description for a given authorised value.
1538 Now takes $category and $value pair too.
1540 my $auth_value_desc =GetAuthorisedValueDesc(
1541 '','', 'DVD' ,'','','CCODE');
1543 If the optional $opac parameter is set to a true value, displays OPAC
1544 descriptions rather than normal ones when they exist.
1548 sub GetAuthorisedValueDesc {
1549 my ( $tag, $subfield, $value, $framework, $tagslib, $category, $opac ) = @_;
1550 my $dbh = C4::Context->dbh;
1554 return $value unless defined $tagslib->{$tag}->{$subfield}->{'authorised_value'};
1557 if ( $tagslib->{$tag}->{$subfield}->{'authorised_value'} eq "branches" ) {
1558 return C4::Branch::GetBranchName($value);
1562 if ( $tagslib->{$tag}->{$subfield}->{'authorised_value'} eq "itemtypes" ) {
1563 return getitemtypeinfo($value)->{description};
1566 #---- "true" authorized value
1567 $category = $tagslib->{$tag}->{$subfield}->{'authorised_value'};
1570 if ( $category ne "" ) {
1571 my $sth = $dbh->prepare( "SELECT lib, lib_opac FROM authorised_values WHERE category = ? AND authorised_value = ?" );
1572 $sth->execute( $category, $value );
1573 my $data = $sth->fetchrow_hashref;
1574 return ( $opac && $data->{'lib_opac'} ) ? $data->{'lib_opac'} : $data->{'lib'};
1576 return $value; # if nothing is found return the original value
1580 =head2 GetMarcControlnumber
1582 $marccontrolnumber = GetMarcControlnumber($record,$marcflavour);
1584 Get the control number / record Identifier from the MARC record and return it.
1588 sub GetMarcControlnumber {
1589 my ( $record, $marcflavour ) = @_;
1590 my $controlnumber = "";
1591 # Control number or Record identifier are the same field in MARC21, UNIMARC and NORMARC
1592 # Keep $marcflavour for possible later use
1593 if ($marcflavour eq "MARC21" || $marcflavour eq "UNIMARC" || $marcflavour eq "NORMARC") {
1594 my $controlnumberField = $record->field('001');
1595 if ($controlnumberField) {
1596 $controlnumber = $controlnumberField->data();
1599 return $controlnumber;
1604 $marcisbnsarray = GetMarcISBN( $record, $marcflavour );
1606 Get all ISBNs from the MARC record and returns them in an array.
1607 ISBNs stored in different fields depending on MARC flavour
1612 my ( $record, $marcflavour ) = @_;
1614 if ( $marcflavour eq "UNIMARC" ) {
1616 } else { # assume marc21 if not unimarc
1623 foreach my $field ( $record->field($scope) ) {
1624 my $value = $field->as_string();
1625 if ( $isbn ne "" ) {
1626 $marcisbn = { marcisbn => $isbn, };
1627 push @marcisbns, $marcisbn;
1630 if ( $isbn ne $value ) {
1631 $isbn = $isbn . " " . $value;
1636 $marcisbn = { marcisbn => $isbn };
1637 push @marcisbns, $marcisbn; #load last tag into array
1645 $marcissnsarray = GetMarcISSN( $record, $marcflavour );
1647 Get all valid ISSNs from the MARC record and returns them in an array.
1648 ISSNs are stored in different fields depending on MARC flavour
1653 my ( $record, $marcflavour ) = @_;
1655 if ( $marcflavour eq "UNIMARC" ) {
1658 else { # assume MARC21 or NORMARC
1662 foreach my $field ( $record->field($scope) ) {
1663 push @marcissns, $field->subfield( 'a' );
1670 $marcnotesarray = GetMarcNotes( $record, $marcflavour );
1672 Get all notes from the MARC record and returns them in an array.
1673 The note are stored in different fields depending on MARC flavour
1678 my ( $record, $marcflavour ) = @_;
1680 if ( $marcflavour eq "UNIMARC" ) {
1682 } else { # assume marc21 if not unimarc
1689 foreach my $field ( $record->field($scope) ) {
1690 my $value = $field->as_string();
1691 if ( $note ne "" ) {
1692 $marcnote = { marcnote => $note, };
1693 push @marcnotes, $marcnote;
1696 if ( $note ne $value ) {
1697 $note = $note . " " . $value;
1702 $marcnote = { marcnote => $note };
1703 push @marcnotes, $marcnote; #load last tag into array
1706 } # end GetMarcNotes
1708 =head2 GetMarcSubjects
1710 $marcsubjcts = GetMarcSubjects($record,$marcflavour);
1712 Get all subjects from the MARC record and returns them in an array.
1713 The subjects are stored in different fields depending on MARC flavour
1717 sub GetMarcSubjects {
1718 my ( $record, $marcflavour ) = @_;
1719 my ( $mintag, $maxtag, $fields_filter );
1720 if ( $marcflavour eq "UNIMARC" ) {
1723 $fields_filter = '6..';
1724 } else { # marc21/normarc
1727 $fields_filter = '6..';
1732 my $subject_limit = C4::Context->preference("TraceCompleteSubfields") ? 'su,complete-subfield' : 'su';
1733 my $authoritysep = C4::Context->preference('authoritysep');
1735 foreach my $field ( $record->field($fields_filter) ) {
1736 next unless ($field->tag() >= $mintag && $field->tag() <= $maxtag);
1738 my @subfields = $field->subfields();
1741 # if there is an authority link, build the links with an= subfield9
1742 my $subfield9 = $field->subfield('9');
1745 my $linkvalue = $subfield9;
1746 $linkvalue =~ s/(\(|\))//g;
1747 @link_loop = ( { limit => 'an', 'link' => $linkvalue } );
1748 $authoritylink = $linkvalue
1752 for my $subject_subfield (@subfields) {
1753 next if ( $subject_subfield->[0] eq '9' );
1755 # don't load unimarc subfields 3,4,5
1756 next if ( ( $marcflavour eq "UNIMARC" ) and ( $subject_subfield->[0] =~ /2|3|4|5/ ) );
1757 # don't load MARC21 subfields 2 (FIXME: any more subfields??)
1758 next if ( ( $marcflavour eq "MARC21" ) and ( $subject_subfield->[0] =~ /2/ ) );
1760 my $code = $subject_subfield->[0];
1761 my $value = $subject_subfield->[1];
1762 my $linkvalue = $value;
1763 $linkvalue =~ s/(\(|\))//g;
1764 # if no authority link, build a search query
1765 unless ($subfield9) {
1767 limit => $subject_limit,
1768 'link' => $linkvalue,
1769 operator => (scalar @link_loop) ? ' and ' : undef
1772 my @this_link_loop = @link_loop;
1774 unless ( $code eq '0' ) {
1775 push @subfields_loop, {
1778 link_loop => \@this_link_loop,
1779 separator => (scalar @subfields_loop) ? $authoritysep : ''
1784 push @marcsubjects, {
1785 MARCSUBJECT_SUBFIELDS_LOOP => \@subfields_loop,
1786 authoritylink => $authoritylink,
1790 return \@marcsubjects;
1791 } #end getMARCsubjects
1793 =head2 GetMarcAuthors
1795 authors = GetMarcAuthors($record,$marcflavour);
1797 Get all authors from the MARC record and returns them in an array.
1798 The authors are stored in different fields depending on MARC flavour
1802 sub GetMarcAuthors {
1803 my ( $record, $marcflavour ) = @_;
1804 my ( $mintag, $maxtag, $fields_filter );
1806 # tagslib useful for UNIMARC author reponsabilities
1808 &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.
1809 if ( $marcflavour eq "UNIMARC" ) {
1812 $fields_filter = '7..';
1813 } else { # marc21/normarc
1816 $fields_filter = '7..';
1820 my $authoritysep = C4::Context->preference('authoritysep');
1822 foreach my $field ( $record->field($fields_filter) ) {
1823 next unless $field->tag() >= $mintag && $field->tag() <= $maxtag;
1826 my @subfields = $field->subfields();
1829 # if there is an authority link, build the link with Koha-Auth-Number: subfield9
1830 my $subfield9 = $field->subfield('9');
1832 my $linkvalue = $subfield9;
1833 $linkvalue =~ s/(\(|\))//g;
1834 @link_loop = ( { 'limit' => 'an', 'link' => $linkvalue } );
1838 for my $authors_subfield (@subfields) {
1839 next if ( $authors_subfield->[0] eq '9' );
1841 # don't load unimarc subfields 3, 5
1842 next if ( $marcflavour eq 'UNIMARC' and ( $authors_subfield->[0] =~ /3|5/ ) );
1844 my $code = $authors_subfield->[0];
1845 my $value = $authors_subfield->[1];
1846 my $linkvalue = $value;
1847 $linkvalue =~ s/(\(|\))//g;
1848 # UNIMARC author responsibility
1849 if ( $marcflavour eq 'UNIMARC' and $code eq '4' ) {
1850 $value = GetAuthorisedValueDesc( $field->tag(), $code, $value, '', $tagslib );
1851 $linkvalue = "($value)";
1853 # if no authority link, build a search query
1854 unless ($subfield9) {
1857 'link' => $linkvalue,
1858 operator => (scalar @link_loop) ? ' and ' : undef
1861 my @this_link_loop = @link_loop;
1863 unless ( $code eq '0') {
1864 push @subfields_loop, {
1865 tag => $field->tag(),
1868 link_loop => \@this_link_loop,
1869 separator => (scalar @subfields_loop) ? $authoritysep : ''
1873 push @marcauthors, {
1874 MARCAUTHOR_SUBFIELDS_LOOP => \@subfields_loop,
1875 authoritylink => $subfield9,
1878 return \@marcauthors;
1883 $marcurls = GetMarcUrls($record,$marcflavour);
1885 Returns arrayref of URLs from MARC data, suitable to pass to tmpl loop.
1886 Assumes web resources (not uncommon in MARC21 to omit resource type ind)
1891 my ( $record, $marcflavour ) = @_;
1894 for my $field ( $record->field('856') ) {
1896 for my $note ( $field->subfield('z') ) {
1897 push @notes, { note => $note };
1899 my @urls = $field->subfield('u');
1900 foreach my $url (@urls) {
1902 if ( $marcflavour eq 'MARC21' ) {
1903 my $s3 = $field->subfield('3');
1904 my $link = $field->subfield('y');
1905 unless ( $url =~ /^\w+:/ ) {
1906 if ( $field->indicator(1) eq '7' ) {
1907 $url = $field->subfield('2') . "://" . $url;
1908 } elsif ( $field->indicator(1) eq '1' ) {
1909 $url = 'ftp://' . $url;
1912 # properly, this should be if ind1=4,
1913 # however we will assume http protocol since we're building a link.
1914 $url = 'http://' . $url;
1918 # TODO handle ind 2 (relationship)
1923 $marcurl->{'linktext'} = $link || $s3 || C4::Context->preference('URLLinkText') || $url;
1924 $marcurl->{'part'} = $s3 if ($link);
1925 $marcurl->{'toc'} = 1 if ( defined($s3) && $s3 =~ /^[Tt]able/ );
1927 $marcurl->{'linktext'} = $field->subfield('2') || C4::Context->preference('URLLinkText') || $url;
1928 $marcurl->{'MARCURL'} = $url;
1930 push @marcurls, $marcurl;
1936 =head2 GetMarcSeries
1938 $marcseriesarray = GetMarcSeries($record,$marcflavour);
1940 Get all series from the MARC record and returns them in an array.
1941 The series are stored in different fields depending on MARC flavour
1946 my ( $record, $marcflavour ) = @_;
1947 my ( $mintag, $maxtag, $fields_filter );
1948 if ( $marcflavour eq "UNIMARC" ) {
1951 $fields_filter = '6..';
1952 } else { # marc21/normarc
1955 $fields_filter = '4..';
1959 my $authoritysep = C4::Context->preference('authoritysep');
1961 foreach my $field ( $record->field($fields_filter) ) {
1962 next unless $field->tag() >= $mintag && $field->tag() <= $maxtag;
1964 my @subfields = $field->subfields();
1967 for my $series_subfield (@subfields) {
1969 # ignore $9, used for authority link
1970 next if ( $series_subfield->[0] eq '9' );
1973 my $code = $series_subfield->[0];
1974 my $value = $series_subfield->[1];
1975 my $linkvalue = $value;
1976 $linkvalue =~ s/(\(|\))//g;
1978 # see if this is an instance of a volume
1979 if ( $code eq 'v' ) {
1984 'link' => $linkvalue,
1985 operator => (scalar @link_loop) ? ' and ' : undef
1988 if ($volume_number) {
1989 push @subfields_loop, { volumenum => $value };
1991 push @subfields_loop, {
1994 link_loop => \@link_loop,
1995 separator => (scalar @subfields_loop) ? $authoritysep : '',
1996 volumenum => $volume_number,
2000 push @marcseries, { MARCSERIES_SUBFIELDS_LOOP => \@subfields_loop };
2003 return \@marcseries;
2004 } #end getMARCseriess
2008 $marchostsarray = GetMarcHosts($record,$marcflavour);
2010 Get all host records (773s MARC21, 461 UNIMARC) from the MARC record and returns them in an array.
2015 my ( $record, $marcflavour ) = @_;
2016 my ( $tag,$title_subf,$bibnumber_subf,$itemnumber_subf);
2017 $marcflavour ||="MARC21";
2018 if ( $marcflavour eq "MARC21" || $marcflavour eq "NORMARC" ) {
2021 $bibnumber_subf ="0";
2022 $itemnumber_subf='9';
2024 elsif ($marcflavour eq "UNIMARC") {
2027 $bibnumber_subf ="0";
2028 $itemnumber_subf='9';
2033 foreach my $field ( $record->field($tag)) {
2037 my $hostbiblionumber = $field->subfield("$bibnumber_subf");
2038 my $hosttitle = $field->subfield($title_subf);
2039 my $hostitemnumber=$field->subfield($itemnumber_subf);
2040 push @fields_loop, { hostbiblionumber => $hostbiblionumber, hosttitle => $hosttitle, hostitemnumber => $hostitemnumber};
2041 push @marchosts, { MARCHOSTS_FIELDS_LOOP => \@fields_loop };
2044 my $marchostsarray = \@marchosts;
2045 return $marchostsarray;
2048 =head2 GetFrameworkCode
2050 $frameworkcode = GetFrameworkCode( $biblionumber )
2054 sub GetFrameworkCode {
2055 my ($biblionumber) = @_;
2056 my $dbh = C4::Context->dbh;
2057 my $sth = $dbh->prepare("SELECT frameworkcode FROM biblio WHERE biblionumber=?");
2058 $sth->execute($biblionumber);
2059 my ($frameworkcode) = $sth->fetchrow;
2060 return $frameworkcode;
2063 =head2 TransformKohaToMarc
2065 $record = TransformKohaToMarc( $hash )
2067 This function builds partial MARC::Record from a hash
2068 Hash entries can be from biblio or biblioitems.
2070 This function is called in acquisition module, to create a basic catalogue
2071 entry from user entry
2076 sub TransformKohaToMarc {
2078 my $record = MARC::Record->new();
2079 SetMarcUnicodeFlag( $record, C4::Context->preference("marcflavour") );
2080 my $db_to_marc = C4::Context->marcfromkohafield;
2081 while ( my ($name, $value) = each %$hash ) {
2082 next unless my $dtm = $db_to_marc->{''}->{$name};
2083 next unless ( scalar( @$dtm ) );
2084 my ($tag, $letter) = @$dtm;
2085 foreach my $value ( split(/\s?\|\s?/, $value, -1) ) {
2086 if ( my $field = $record->field($tag) ) {
2087 $field->add_subfields( $letter => $value );
2090 $record->insert_fields_ordered( MARC::Field->new(
2091 $tag, " ", " ", $letter => $value ) );
2099 =head2 PrepHostMarcField
2101 $hostfield = PrepHostMarcField ( $hostbiblionumber,$hostitemnumber,$marcflavour )
2103 This function returns a host field populated with data from the host record, the field can then be added to an analytical record
2107 sub PrepHostMarcField {
2108 my ($hostbiblionumber,$hostitemnumber, $marcflavour) = @_;
2109 $marcflavour ||="MARC21";
2112 my $hostrecord = GetMarcBiblio($hostbiblionumber);
2113 my $item = C4::Items::GetItem($hostitemnumber);
2116 if ( $marcflavour eq "MARC21" || $marcflavour eq "NORMARC" ) {
2120 if ($hostrecord->subfield('100','a')){
2121 $mainentry = $hostrecord->subfield('100','a');
2122 } elsif ($hostrecord->subfield('110','a')){
2123 $mainentry = $hostrecord->subfield('110','a');
2125 $mainentry = $hostrecord->subfield('111','a');
2128 # qualification info
2130 if (my $field260 = $hostrecord->field('260')){
2131 $qualinfo = $field260->as_string( 'abc' );
2136 my $ed = $hostrecord->subfield('250','a');
2137 my $barcode = $item->{'barcode'};
2138 my $title = $hostrecord->subfield('245','a');
2140 # record control number, 001 with 003 and prefix
2142 if ($hostrecord->field('001')){
2143 $recctrlno = $hostrecord->field('001')->data();
2144 if ($hostrecord->field('003')){
2145 $recctrlno = '('.$hostrecord->field('003')->data().')'.$recctrlno;
2150 my $issn = $hostrecord->subfield('022','a');
2151 my $isbn = $hostrecord->subfield('020','a');
2154 $hostmarcfield = MARC::Field->new(
2156 '0' => $hostbiblionumber,
2157 '9' => $hostitemnumber,
2167 } elsif ($marcflavour eq "UNIMARC") {
2168 $hostmarcfield = MARC::Field->new(
2170 '0' => $hostbiblionumber,
2171 't' => $hostrecord->subfield('200','a'),
2172 '9' => $hostitemnumber
2176 return $hostmarcfield;
2179 =head2 TransformHtmlToXml
2181 $xml = TransformHtmlToXml( $tags, $subfields, $values, $indicator,
2182 $ind_tag, $auth_type )
2184 $auth_type contains :
2188 =item - nothing : rebuild a biblio. In UNIMARC the encoding is in 100$a pos 26/27
2190 =item - UNIMARCAUTH : rebuild an authority. In UNIMARC, the encoding is in 100$a pos 13/14
2192 =item - ITEM : rebuild an item : in UNIMARC, 100$a, it's in the biblio ! (otherwise, we would get 2 100 fields !)
2198 sub TransformHtmlToXml {
2199 my ( $tags, $subfields, $values, $indicator, $ind_tag, $auth_type ) = @_;
2200 my $xml = MARC::File::XML::header('UTF-8');
2201 $xml .= "<record>\n";
2202 $auth_type = C4::Context->preference('marcflavour') unless $auth_type;
2203 MARC::File::XML->default_record_format($auth_type);
2205 # in UNIMARC, field 100 contains the encoding
2206 # check that there is one, otherwise the
2207 # MARC::Record->new_from_xml will fail (and Koha will die)
2208 my $unimarc_and_100_exist = 0;
2209 $unimarc_and_100_exist = 1 if $auth_type eq 'ITEM'; # if we rebuild an item, no need of a 100 field
2214 for ( my $i = 0 ; $i < @$tags ; $i++ ) {
2216 if ( C4::Context->preference('marcflavour') eq 'UNIMARC' and @$tags[$i] eq "100" and @$subfields[$i] eq "a" ) {
2218 # if we have a 100 field and it's values are not correct, skip them.
2219 # if we don't have any valid 100 field, we will create a default one at the end
2220 my $enc = substr( @$values[$i], 26, 2 );
2221 if ( $enc eq '01' or $enc eq '50' or $enc eq '03' ) {
2222 $unimarc_and_100_exist = 1;
2227 @$values[$i] =~ s/&/&/g;
2228 @$values[$i] =~ s/</</g;
2229 @$values[$i] =~ s/>/>/g;
2230 @$values[$i] =~ s/"/"/g;
2231 @$values[$i] =~ s/'/'/g;
2233 # if ( !utf8::is_utf8( @$values[$i] ) ) {
2234 # utf8::decode( @$values[$i] );
2236 if ( ( @$tags[$i] ne $prevtag ) ) {
2237 $j++ unless ( @$tags[$i] eq "" );
2238 my $indicator1 = eval { substr( @$indicator[$j], 0, 1 ) };
2239 my $indicator2 = eval { substr( @$indicator[$j], 1, 1 ) };
2240 my $ind1 = _default_ind_to_space($indicator1);
2242 if ( @$indicator[$j] ) {
2243 $ind2 = _default_ind_to_space($indicator2);
2245 warn "Indicator in @$tags[$i] is empty";
2249 $xml .= "</datafield>\n";
2250 if ( ( @$tags[$i] && @$tags[$i] > 10 )
2251 && ( @$values[$i] ne "" ) ) {
2252 $xml .= "<datafield tag=\"@$tags[$i]\" ind1=\"$ind1\" ind2=\"$ind2\">\n";
2253 $xml .= "<subfield code=\"@$subfields[$i]\">@$values[$i]</subfield>\n";
2259 if ( @$values[$i] ne "" ) {
2262 if ( @$tags[$i] eq "000" ) {
2263 $xml .= "<leader>@$values[$i]</leader>\n";
2266 # rest of the fixed fields
2267 } elsif ( @$tags[$i] < 10 ) {
2268 $xml .= "<controlfield tag=\"@$tags[$i]\">@$values[$i]</controlfield>\n";
2271 $xml .= "<datafield tag=\"@$tags[$i]\" ind1=\"$ind1\" ind2=\"$ind2\">\n";
2272 $xml .= "<subfield code=\"@$subfields[$i]\">@$values[$i]</subfield>\n";
2277 } else { # @$tags[$i] eq $prevtag
2278 my $indicator1 = eval { substr( @$indicator[$j], 0, 1 ) };
2279 my $indicator2 = eval { substr( @$indicator[$j], 1, 1 ) };
2280 my $ind1 = _default_ind_to_space($indicator1);
2282 if ( @$indicator[$j] ) {
2283 $ind2 = _default_ind_to_space($indicator2);
2285 warn "Indicator in @$tags[$i] is empty";
2288 if ( @$values[$i] eq "" ) {
2291 $xml .= "<datafield tag=\"@$tags[$i]\" ind1=\"$ind1\" ind2=\"$ind2\">\n";
2294 $xml .= "<subfield code=\"@$subfields[$i]\">@$values[$i]</subfield>\n";
2297 $prevtag = @$tags[$i];
2299 $xml .= "</datafield>\n" if $xml =~ m/<datafield/;
2300 if ( C4::Context->preference('marcflavour') eq 'UNIMARC' and !$unimarc_and_100_exist ) {
2302 # warn "SETTING 100 for $auth_type";
2303 my $string = strftime( "%Y%m%d", localtime(time) );
2305 # set 50 to position 26 is biblios, 13 if authorities
2307 $pos = 13 if $auth_type eq 'UNIMARCAUTH';
2308 $string = sprintf( "%-*s", 35, $string );
2309 substr( $string, $pos, 6, "50" );
2310 $xml .= "<datafield tag=\"100\" ind1=\"\" ind2=\"\">\n";
2311 $xml .= "<subfield code=\"a\">$string</subfield>\n";
2312 $xml .= "</datafield>\n";
2314 $xml .= "</record>\n";
2315 $xml .= MARC::File::XML::footer();
2319 =head2 _default_ind_to_space
2321 Passed what should be an indicator returns a space
2322 if its undefined or zero length
2326 sub _default_ind_to_space {
2328 if ( !defined $s || $s eq q{} ) {
2334 =head2 TransformHtmlToMarc
2336 L<$record> = TransformHtmlToMarc(L<$cgi>)
2337 L<$cgi> is the CGI object which containts the values for subfields
2339 'tag_010_indicator1_531951' ,
2340 'tag_010_indicator2_531951' ,
2341 'tag_010_code_a_531951_145735' ,
2342 'tag_010_subfield_a_531951_145735' ,
2343 'tag_200_indicator1_873510' ,
2344 'tag_200_indicator2_873510' ,
2345 'tag_200_code_a_873510_673465' ,
2346 'tag_200_subfield_a_873510_673465' ,
2347 'tag_200_code_b_873510_704318' ,
2348 'tag_200_subfield_b_873510_704318' ,
2349 'tag_200_code_e_873510_280822' ,
2350 'tag_200_subfield_e_873510_280822' ,
2351 'tag_200_code_f_873510_110730' ,
2352 'tag_200_subfield_f_873510_110730' ,
2354 L<$record> is the MARC::Record object.
2358 sub TransformHtmlToMarc {
2361 my @params = $cgi->param();
2363 # explicitly turn on the UTF-8 flag for all
2364 # 'tag_' parameters to avoid incorrect character
2365 # conversion later on
2366 my $cgi_params = $cgi->Vars;
2367 foreach my $param_name ( keys %$cgi_params ) {
2368 if ( $param_name =~ /^tag_/ ) {
2369 my $param_value = $cgi_params->{$param_name};
2370 if ( utf8::decode($param_value) ) {
2371 $cgi_params->{$param_name} = $param_value;
2374 # FIXME - need to do something if string is not valid UTF-8
2378 # creating a new record
2379 my $record = MARC::Record->new();
2382 #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!
2383 while ( $params[$i] ) { # browse all CGI params
2384 my $param = $params[$i];
2387 # if we are on biblionumber, store it in the MARC::Record (it may not be in the edited fields)
2388 if ( $param eq 'biblionumber' ) {
2389 my ( $biblionumbertagfield, $biblionumbertagsubfield ) = &GetMarcFromKohaField( "biblio.biblionumber", '' );
2390 if ( $biblionumbertagfield < 10 ) {
2391 $newfield = MARC::Field->new( $biblionumbertagfield, $cgi->param($param), );
2393 $newfield = MARC::Field->new( $biblionumbertagfield, '', '', "$biblionumbertagsubfield" => $cgi->param($param), );
2395 push @fields, $newfield if ($newfield);
2396 } elsif ( $param =~ /^tag_(\d*)_indicator1_/ ) { # new field start when having 'input name="..._indicator1_..."
2399 my $ind1 = _default_ind_to_space( substr( $cgi->param($param), 0, 1 ) );
2400 my $ind2 = _default_ind_to_space( substr( $cgi->param( $params[ $i + 1 ] ), 0, 1 ) );
2404 if ( $tag < 10 ) { # no code for theses fields
2405 # in MARC editor, 000 contains the leader.
2406 if ( $tag eq '000' ) {
2407 # Force a fake leader even if not provided to avoid crashing
2408 # during decoding MARC record containing UTF-8 characters
2410 length( $cgi->param($params[$j+1]) ) == 24
2411 ? $cgi->param( $params[ $j + 1 ] )
2415 # between 001 and 009 (included)
2416 } elsif ( $cgi->param( $params[ $j + 1 ] ) ne '' ) {
2417 $newfield = MARC::Field->new( $tag, $cgi->param( $params[ $j + 1 ] ), );
2420 # > 009, deal with subfields
2422 # browse subfields for this tag (reason for _code_ match)
2423 while(defined $params[$j] && $params[$j] =~ /_code_/) {
2424 last unless defined $params[$j+1];
2425 #if next param ne subfield, then it was probably empty
2426 #try next param by incrementing j
2427 if($params[$j+1]!~/_subfield_/) {$j++; next; }
2428 my $fval= $cgi->param($params[$j+1]);
2429 #check if subfield value not empty and field exists
2430 if($fval ne '' && $newfield) {
2431 $newfield->add_subfields( $cgi->param($params[$j]) => $fval);
2433 elsif($fval ne '') {
2434 $newfield = MARC::Field->new( $tag, $ind1, $ind2, $cgi->param($params[$j]) => $fval );
2438 $i= $j-1; #update i for outer loop accordingly
2440 push @fields, $newfield if ($newfield);
2445 $record->append_fields(@fields);
2449 # cache inverted MARC field map
2450 our $inverted_field_map;
2452 =head2 TransformMarcToKoha
2454 $result = TransformMarcToKoha( $dbh, $record, $frameworkcode )
2456 Extract data from a MARC bib record into a hashref representing
2457 Koha biblio, biblioitems, and items fields.
2461 sub TransformMarcToKoha {
2462 my ( $dbh, $record, $frameworkcode, $limit_table ) = @_;
2465 $limit_table = $limit_table || 0;
2466 $frameworkcode = '' unless defined $frameworkcode;
2468 unless ( defined $inverted_field_map ) {
2469 $inverted_field_map = _get_inverted_marc_field_map();
2473 if ( defined $limit_table && $limit_table eq 'items' ) {
2474 $tables{'items'} = 1;
2476 $tables{'items'} = 1;
2477 $tables{'biblio'} = 1;
2478 $tables{'biblioitems'} = 1;
2481 # traverse through record
2482 MARCFIELD: foreach my $field ( $record->fields() ) {
2483 my $tag = $field->tag();
2484 next MARCFIELD unless exists $inverted_field_map->{$frameworkcode}->{$tag};
2485 if ( $field->is_control_field() ) {
2486 my $kohafields = $inverted_field_map->{$frameworkcode}->{$tag}->{list};
2487 ENTRY: foreach my $entry ( @{$kohafields} ) {
2488 my ( $subfield, $table, $column ) = @{$entry};
2489 next ENTRY unless exists $tables{$table};
2490 my $key = _disambiguate( $table, $column );
2491 if ( $result->{$key} ) {
2492 unless ( ( $key eq "biblionumber" or $key eq "biblioitemnumber" ) and ( $field->data() eq "" ) ) {
2493 $result->{$key} .= " | " . $field->data();
2496 $result->{$key} = $field->data();
2501 # deal with subfields
2502 MARCSUBFIELD: foreach my $sf ( $field->subfields() ) {
2503 my $code = $sf->[0];
2504 next MARCSUBFIELD unless exists $inverted_field_map->{$frameworkcode}->{$tag}->{sfs}->{$code};
2505 my $value = $sf->[1];
2506 SFENTRY: foreach my $entry ( @{ $inverted_field_map->{$frameworkcode}->{$tag}->{sfs}->{$code} } ) {
2507 my ( $table, $column ) = @{$entry};
2508 next SFENTRY unless exists $tables{$table};
2509 my $key = _disambiguate( $table, $column );
2510 if ( $result->{$key} ) {
2511 unless ( ( $key eq "biblionumber" or $key eq "biblioitemnumber" ) and ( $value eq "" ) ) {
2512 $result->{$key} .= " | " . $value;
2515 $result->{$key} = $value;
2522 # modify copyrightdate to keep only the 1st year found
2523 if ( exists $result->{'copyrightdate'} ) {
2524 my $temp = $result->{'copyrightdate'};
2525 $temp =~ m/c(\d\d\d\d)/;
2526 if ( $temp =~ m/c(\d\d\d\d)/ and $1 > 0 ) { # search cYYYY first
2527 $result->{'copyrightdate'} = $1;
2528 } else { # if no cYYYY, get the 1st date.
2529 $temp =~ m/(\d\d\d\d)/;
2530 $result->{'copyrightdate'} = $1;
2534 # modify publicationyear to keep only the 1st year found
2535 if ( exists $result->{'publicationyear'} ) {
2536 my $temp = $result->{'publicationyear'};
2537 if ( $temp =~ m/c(\d\d\d\d)/ and $1 > 0 ) { # search cYYYY first
2538 $result->{'publicationyear'} = $1;
2539 } else { # if no cYYYY, get the 1st date.
2540 $temp =~ m/(\d\d\d\d)/;
2541 $result->{'publicationyear'} = $1;
2548 sub _get_inverted_marc_field_map {
2550 my $relations = C4::Context->marcfromkohafield;
2552 foreach my $frameworkcode ( keys %{$relations} ) {
2553 foreach my $kohafield ( keys %{ $relations->{$frameworkcode} } ) {
2554 next unless @{ $relations->{$frameworkcode}->{$kohafield} }; # not all columns are mapped to MARC tag & subfield
2555 my $tag = $relations->{$frameworkcode}->{$kohafield}->[0];
2556 my $subfield = $relations->{$frameworkcode}->{$kohafield}->[1];
2557 my ( $table, $column ) = split /[.]/, $kohafield, 2;
2558 push @{ $field_map->{$frameworkcode}->{$tag}->{list} }, [ $subfield, $table, $column ];
2559 push @{ $field_map->{$frameworkcode}->{$tag}->{sfs}->{$subfield} }, [ $table, $column ];
2565 =head2 _disambiguate
2567 $newkey = _disambiguate($table, $field);
2569 This is a temporary hack to distinguish between the
2570 following sets of columns when using TransformMarcToKoha.
2572 items.cn_source & biblioitems.cn_source
2573 items.cn_sort & biblioitems.cn_sort
2575 Columns that are currently NOT distinguished (FIXME
2576 due to lack of time to fully test) are:
2578 biblio.notes and biblioitems.notes
2583 FIXME - this is necessary because prefixing each column
2584 name with the table name would require changing lots
2585 of code and templates, and exposing more of the DB
2586 structure than is good to the UI templates, particularly
2587 since biblio and bibloitems may well merge in a future
2588 version. In the future, it would also be good to
2589 separate DB access and UI presentation field names
2594 sub CountItemsIssued {
2595 my ($biblionumber) = @_;
2596 my $dbh = C4::Context->dbh;
2597 my $sth = $dbh->prepare('SELECT COUNT(*) as issuedCount FROM items, issues WHERE items.itemnumber = issues.itemnumber AND items.biblionumber = ?');
2598 $sth->execute($biblionumber);
2599 my $row = $sth->fetchrow_hashref();
2600 return $row->{'issuedCount'};
2604 my ( $table, $column ) = @_;
2605 if ( $column eq "cn_sort" or $column eq "cn_source" ) {
2606 return $table . '.' . $column;
2613 =head2 get_koha_field_from_marc
2615 $result->{_disambiguate($table, $field)} =
2616 get_koha_field_from_marc($table,$field,$record,$frameworkcode);
2618 Internal function to map data from the MARC record to a specific non-MARC field.
2619 FIXME: this is meant to replace TransformMarcToKohaOneField after more testing.
2623 sub get_koha_field_from_marc {
2624 my ( $koha_table, $koha_column, $record, $frameworkcode ) = @_;
2625 my ( $tagfield, $subfield ) = GetMarcFromKohaField( $koha_table . '.' . $koha_column, $frameworkcode );
2627 foreach my $field ( $record->field($tagfield) ) {
2628 if ( $field->tag() < 10 ) {
2630 $kohafield .= " | " . $field->data();
2632 $kohafield = $field->data();
2635 if ( $field->subfields ) {
2636 my @subfields = $field->subfields();
2637 foreach my $subfieldcount ( 0 .. $#subfields ) {
2638 if ( $subfields[$subfieldcount][0] eq $subfield ) {
2640 $kohafield .= " | " . $subfields[$subfieldcount][1];
2642 $kohafield = $subfields[$subfieldcount][1];
2652 =head2 TransformMarcToKohaOneField
2654 $result = TransformMarcToKohaOneField( $kohatable, $kohafield, $record, $result, $frameworkcode )
2658 sub TransformMarcToKohaOneField {
2660 # FIXME ? if a field has a repeatable subfield that is used in old-db,
2661 # only the 1st will be retrieved...
2662 my ( $kohatable, $kohafield, $record, $result, $frameworkcode ) = @_;
2664 my ( $tagfield, $subfield ) = GetMarcFromKohaField( $kohatable . "." . $kohafield, $frameworkcode );
2665 foreach my $field ( $record->field($tagfield) ) {
2666 if ( $field->tag() < 10 ) {
2667 if ( $result->{$kohafield} ) {
2668 $result->{$kohafield} .= " | " . $field->data();
2670 $result->{$kohafield} = $field->data();
2673 if ( $field->subfields ) {
2674 my @subfields = $field->subfields();
2675 foreach my $subfieldcount ( 0 .. $#subfields ) {
2676 if ( $subfields[$subfieldcount][0] eq $subfield ) {
2677 if ( $result->{$kohafield} ) {
2678 $result->{$kohafield} .= " | " . $subfields[$subfieldcount][1];
2680 $result->{$kohafield} = $subfields[$subfieldcount][1];
2694 # true ModZebra commented until indexdata fixes zebraDB crashes (it seems they occur on multiple updates
2696 # replaced by a zebraqueue table, that is filled with ModZebra to run.
2697 # the table is emptied by misc/cronjobs/zebraqueue_start.pl script
2698 # =head2 ModZebrafiles
2700 # &ModZebrafiles( $dbh, $biblionumber, $record, $folder, $server );
2704 # sub ModZebrafiles {
2706 # my ( $dbh, $biblionumber, $record, $folder, $server ) = @_;
2710 # C4::Context->zebraconfig($server)->{directory} . "/" . $folder . "/";
2711 # unless ( opendir( DIR, "$zebradir" ) ) {
2712 # warn "$zebradir not found";
2716 # my $filename = $zebradir . $biblionumber;
2719 # open( OUTPUT, ">", $filename . ".xml" );
2720 # print OUTPUT $record;
2727 ModZebra( $biblionumber, $op, $server, $oldRecord, $newRecord );
2729 $biblionumber is the biblionumber we want to index
2731 $op is specialUpdate or delete, and is used to know what we want to do
2733 $server is the server that we want to update
2735 $oldRecord is the MARC::Record containing the previous version of the record. This is used only when
2736 NoZebra=1, as NoZebra indexing needs to know the previous version of a record in order to
2739 $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.
2744 ###Accepts a $server variable thus we can use it for biblios authorities or other zebra dbs
2745 my ( $biblionumber, $op, $server, $oldRecord, $newRecord ) = @_;
2746 my $dbh = C4::Context->dbh;
2748 # true ModZebra commented until indexdata fixes zebraDB crashes (it seems they occur on multiple updates
2750 # replaced by a zebraqueue table, that is filled with ModZebra to run.
2751 # the table is emptied by misc/cronjobs/zebraqueue_start.pl script
2753 if ( C4::Context->preference("NoZebra") ) {
2755 # lock the nozebra table : we will read index lines, update them in Perl process
2756 # and write everything in 1 transaction.
2757 # lock the table to avoid someone else overwriting what we are doing
2758 $dbh->do('LOCK TABLES nozebra WRITE,biblio WRITE,biblioitems WRITE, systempreferences WRITE, auth_types WRITE, auth_header WRITE, auth_subfield_structure READ');
2759 my %result; # the result hash that will be built by deletion / add, and written on mySQL at the end, to improve speed
2760 if ( $op eq 'specialUpdate' ) {
2762 # OK, we have to add or update the record
2763 # 1st delete (virtually, in indexes), if record actually exists
2765 %result = _DelBiblioNoZebra( $biblionumber, $oldRecord, $server );
2768 # ... add the record
2769 %result = _AddBiblioNoZebra( $biblionumber, $newRecord, $server, %result );
2772 # it's a deletion, delete the record...
2773 # warn "DELETE the record $biblionumber on $server".$record->as_formatted;
2774 %result = _DelBiblioNoZebra( $biblionumber, $oldRecord, $server );
2777 # ok, now update the database...
2778 my $sth = $dbh->prepare("UPDATE nozebra SET biblionumbers=? WHERE server=? AND indexname=? AND value=?");
2779 foreach my $key ( keys %result ) {
2780 foreach my $index ( keys %{ $result{$key} } ) {
2781 $sth->execute( $result{$key}->{$index}, $server, $key, $index );
2784 $dbh->do('UNLOCK TABLES');
2788 # we use zebra, just fill zebraqueue table
2790 my $check_sql = "SELECT COUNT(*) FROM zebraqueue
2792 AND biblio_auth_number = ?
2795 my $check_sth = $dbh->prepare_cached($check_sql);
2796 $check_sth->execute( $server, $biblionumber, $op );
2797 my ($count) = $check_sth->fetchrow_array;
2798 $check_sth->finish();
2799 if ( $count == 0 ) {
2800 my $sth = $dbh->prepare("INSERT INTO zebraqueue (biblio_auth_number,server,operation) VALUES(?,?,?)");
2801 $sth->execute( $biblionumber, $server, $op );
2807 =head2 GetNoZebraIndexes
2809 %indexes = GetNoZebraIndexes;
2811 return the data from NoZebraIndexes syspref.
2815 sub GetNoZebraIndexes {
2816 my $no_zebra_indexes = C4::Context->preference('NoZebraIndexes');
2818 INDEX: foreach my $line ( split /['"],[\n\r]*/, $no_zebra_indexes ) {
2819 $line =~ /(.*)=>(.*)/;
2820 my $index = $1; # initial ' or " is removed afterwards
2822 $index =~ s/'|"|\s//g;
2823 $fields =~ s/'|"|\s//g;
2824 $indexes{$index} = $fields;
2829 =head2 EmbedItemsInMarcBiblio
2831 EmbedItemsInMarcBiblio($marc, $biblionumber, $itemnumbers);
2833 Given a MARC::Record object containing a bib record,
2834 modify it to include the items attached to it as 9XX
2835 per the bib's MARC framework.
2836 if $itemnumbers is defined, only specified itemnumbers are embedded
2840 sub EmbedItemsInMarcBiblio {
2841 my ($marc, $biblionumber, $itemnumbers) = @_;
2842 croak "No MARC record" unless $marc;
2844 $itemnumbers = [] unless defined $itemnumbers;
2846 my $frameworkcode = GetFrameworkCode($biblionumber);
2847 _strip_item_fields($marc, $frameworkcode);
2849 # ... and embed the current items
2850 my $dbh = C4::Context->dbh;
2851 my $sth = $dbh->prepare("SELECT itemnumber FROM items WHERE biblionumber = ?");
2852 $sth->execute($biblionumber);
2854 my ( $itemtag, $itemsubfield ) = GetMarcFromKohaField( "items.itemnumber", $frameworkcode );
2855 while (my ($itemnumber) = $sth->fetchrow_array) {
2856 next if @$itemnumbers and not grep { $_ == $itemnumber } @$itemnumbers;
2858 my $item_marc = C4::Items::GetMarcItem($biblionumber, $itemnumber);
2859 push @item_fields, $item_marc->field($itemtag);
2861 $marc->append_fields(@item_fields);
2864 =head1 INTERNAL FUNCTIONS
2866 =head2 _DelBiblioNoZebra($biblionumber,$record,$server);
2868 function to delete a biblio in NoZebra indexes
2869 This function does NOT delete anything in database : it reads all the indexes entries
2870 that have to be deleted & delete them in the hash
2872 The SQL part is done either :
2873 - after the Add if we are modifying a biblio (delete + add again)
2874 - immediatly after this sub if we are doing a true deletion.
2876 $server can be 'biblioserver' or 'authorityserver' : it indexes biblios or authorities (in the same table, $server being part of the table itself
2880 sub _DelBiblioNoZebra {
2881 my ( $biblionumber, $record, $server ) = @_;
2884 my $dbh = C4::Context->dbh;
2889 if ( $server eq 'biblioserver' ) {
2890 %index = GetNoZebraIndexes;
2892 # get title of the record (to store the 10 first letters with the index)
2893 my ( $titletag, $titlesubfield ) = GetMarcFromKohaField( 'biblio.title', '' ); # FIXME: should be GetFrameworkCode($biblionumber) ??
2894 $title = lc( $record->subfield( $titletag, $titlesubfield ) );
2897 # for authorities, the "title" is the $a mainentry
2898 my ( $auth_type_tag, $auth_type_sf ) = C4::AuthoritiesMarc::get_auth_type_location();
2899 my $authref = C4::AuthoritiesMarc::GetAuthType( $record->subfield( $auth_type_tag, $auth_type_sf ) );
2900 warn "ERROR : authtype undefined for " . $record->as_formatted unless $authref;
2901 $title = $record->subfield( $authref->{auth_tag_to_report}, 'a' );
2902 $index{'mainmainentry'} = $authref->{'auth_tag_to_report'} . 'a';
2903 $index{'mainentry'} = $authref->{'auth_tag_to_report'} . '*';
2904 $index{'auth_type'} = "${auth_type_tag}${auth_type_sf}";
2909 # remove blancks comma (that could cause problem when decoding the string for CQL retrieval) and regexp specific values
2910 $title =~ s/ |,|;|\[|\]|\(|\)|\*|-|'|=//g;
2912 # limit to 10 char, should be enough, and limit the DB size
2913 $title = substr( $title, 0, 10 );
2916 my $sth2 = $dbh->prepare('SELECT biblionumbers FROM nozebra WHERE server=? AND indexname=? AND value=?');
2917 foreach my $field ( $record->fields() ) {
2919 #parse each subfield
2920 next if $field->tag < 10;
2921 foreach my $subfield ( $field->subfields() ) {
2922 my $tag = $field->tag();
2923 my $subfieldcode = $subfield->[0];
2926 # check each index to see if the subfield is stored somewhere
2927 # otherwise, store it in __RAW__ index
2928 foreach my $key ( keys %index ) {
2930 # warn "examining $key index : ".$index{$key}." for $tag $subfieldcode";
2931 if ( $index{$key} =~ /$tag\*/ or $index{$key} =~ /$tag$subfieldcode/ ) {
2933 my $line = lc $subfield->[1];
2935 # remove meaningless value in the field...
2936 $line =~ s/-|\.|\?|,|;|!|'|\(|\)|\[|\]|{|}|"|<|>|&|\+|\*|\/|=|:/ /g;
2938 # ... and split in words
2939 foreach ( split / /, $line ) {
2940 next unless $_; # skip empty values (multiple spaces)
2941 # if the entry is already here, do nothing, the biblionumber has already be removed
2942 unless ( defined( $result{$key}->{$_} ) && ( $result{$key}->{$_} =~ /$biblionumber,$title\-(\d);/ ) ) {
2944 # get the index value if it exist in the nozebra table and remove the entry, otherwise, do nothing
2945 $sth2->execute( $server, $key, $_ );
2946 my $existing_biblionumbers = $sth2->fetchrow;
2949 if ($existing_biblionumbers) {
2951 # warn " existing for $key $_: $existing_biblionumbers";
2952 $result{$key}->{$_} = $existing_biblionumbers;
2953 $result{$key}->{$_} =~ s/$biblionumber,$title\-(\d);//;
2960 # the subfield is not indexed, store it in __RAW__ index anyway
2962 my $line = lc $subfield->[1];
2963 $line =~ s/-|\.|\?|,|;|!|'|\(|\)|\[|\]|{|}|"|<|>|&|\+|\*|\/|=|:/ /g;
2965 # ... and split in words
2966 foreach ( split / /, $line ) {
2967 next unless $_; # skip empty values (multiple spaces)
2968 # if the entry is already here, do nothing, the biblionumber has already be removed
2969 unless ( $result{'__RAW__'}->{$_} =~ /$biblionumber,$title\-(\d);/ ) {
2971 # get the index value if it exist in the nozebra table and remove the entry, otherwise, do nothing
2972 $sth2->execute( $server, '__RAW__', $_ );
2973 my $existing_biblionumbers = $sth2->fetchrow;
2976 if ($existing_biblionumbers) {
2977 $result{'__RAW__'}->{$_} = $existing_biblionumbers;
2978 $result{'__RAW__'}->{$_} =~ s/$biblionumber,$title\-(\d);//;
2988 =head2 _AddBiblioNoZebra
2990 _AddBiblioNoZebra($biblionumber, $record, $server, %result);
2992 function to add a biblio in NoZebra indexes
2996 sub _AddBiblioNoZebra {
2997 my ( $biblionumber, $record, $server, %result ) = @_;
2998 my $dbh = C4::Context->dbh;
3003 if ( $server eq 'biblioserver' ) {
3004 %index = GetNoZebraIndexes;
3006 # get title of the record (to store the 10 first letters with the index)
3007 my ( $titletag, $titlesubfield ) = GetMarcFromKohaField( 'biblio.title', '' ); # FIXME: should be GetFrameworkCode($biblionumber) ??
3008 $title = lc( $record->subfield( $titletag, $titlesubfield ) );
3011 # warn "server : $server";
3012 # for authorities, the "title" is the $a mainentry
3013 my ( $auth_type_tag, $auth_type_sf ) = C4::AuthoritiesMarc::get_auth_type_location();
3014 my $authref = C4::AuthoritiesMarc::GetAuthType( $record->subfield( $auth_type_tag, $auth_type_sf ) );
3015 warn "ERROR : authtype undefined for " . $record->as_formatted unless $authref;
3016 $title = $record->subfield( $authref->{auth_tag_to_report}, 'a' );
3017 $index{'mainmainentry'} = $authref->{auth_tag_to_report} . 'a';
3018 $index{'mainentry'} = $authref->{auth_tag_to_report} . '*';
3019 $index{'auth_type'} = "${auth_type_tag}${auth_type_sf}";
3022 # remove blancks comma (that could cause problem when decoding the string for CQL retrieval) and regexp specific values
3023 $title =~ s/ |\.|,|;|\[|\]|\(|\)|\*|-|'|:|=|\r|\n//g;
3025 # limit to 10 char, should be enough, and limit the DB size
3026 $title = substr( $title, 0, 10 );
3029 my $sth2 = $dbh->prepare('SELECT biblionumbers FROM nozebra WHERE server=? AND indexname=? AND value=?');
3030 foreach my $field ( $record->fields() ) {
3032 #parse each subfield
3033 ###FIXME: impossible to index a 001-009 value with NoZebra
3034 next if $field->tag < 10;
3035 foreach my $subfield ( $field->subfields() ) {
3036 my $tag = $field->tag();
3037 my $subfieldcode = $subfield->[0];
3040 # warn "INDEXING :".$subfield->[1];
3041 # check each index to see if the subfield is stored somewhere
3042 # otherwise, store it in __RAW__ index
3043 foreach my $key ( keys %index ) {
3045 # warn "examining $key index : ".$index{$key}." for $tag $subfieldcode";
3046 if ( $index{$key} =~ /$tag\*/ or $index{$key} =~ /$tag$subfieldcode/ ) {
3048 my $line = lc $subfield->[1];
3050 # remove meaningless value in the field...
3051 $line =~ s/-|\.|\?|,|;|!|'|\(|\)|\[|\]|{|}|"|<|>|&|\+|\*|\/|=|:|\r|\n/ /g;
3053 # ... and split in words
3054 foreach ( split / /, $line ) {
3055 next unless $_; # skip empty values (multiple spaces)
3056 # if the entry is already here, improve weight
3058 # warn "managing $_";
3059 if ( exists $result{$key}->{$_} && $result{$key}->{"$_"} =~ /$biblionumber,\Q$title\E\-(\d+);/ ) {
3060 my $weight = $1 + 1;
3061 $result{$key}->{"$_"} =~ s/$biblionumber,\Q$title\E\-(\d+);//g;
3062 $result{$key}->{"$_"} .= "$biblionumber,$title-$weight;";
3065 # get the value if it exist in the nozebra table, otherwise, create it
3066 $sth2->execute( $server, $key, $_ );
3067 my $existing_biblionumbers = $sth2->fetchrow;
3070 if ($existing_biblionumbers) {
3071 $result{$key}->{"$_"} = $existing_biblionumbers;
3072 my $weight = defined $1 ? $1 + 1 : 1;
3073 $result{$key}->{"$_"} =~ s/$biblionumber,\Q$title\E\-(\d+);//g;
3074 $result{$key}->{"$_"} .= "$biblionumber,$title-$weight;";
3076 # create a new ligne for this entry
3079 # warn "INSERT : $server / $key / $_";
3080 $dbh->do( 'INSERT INTO nozebra SET server=' . $dbh->quote($server) . ', indexname=' . $dbh->quote($key) . ',value=' . $dbh->quote($_) );
3081 $result{$key}->{"$_"} .= "$biblionumber,$title-1;";
3088 # the subfield is not indexed, store it in __RAW__ index anyway
3090 my $line = lc $subfield->[1];
3091 $line =~ s/-|\.|\?|,|;|!|'|\(|\)|\[|\]|{|}|"|<|>|&|\+|\*|\/|=|:|\r|\n/ /g;
3093 # ... and split in words
3094 foreach ( split / /, $line ) {
3095 next unless $_; # skip empty values (multiple spaces)
3096 # if the entry is already here, improve weight
3097 my $tmpstr = $result{'__RAW__'}->{"$_"} || "";
3098 if ( $tmpstr =~ /$biblionumber,\Q$title\E\-(\d+);/ ) {
3099 my $weight = $1 + 1;
3100 $result{'__RAW__'}->{"$_"} =~ s/$biblionumber,\Q$title\E\-(\d+);//;
3101 $result{'__RAW__'}->{"$_"} .= "$biblionumber,$title-$weight;";
3104 # get the value if it exist in the nozebra table, otherwise, create it
3105 $sth2->execute( $server, '__RAW__', $_ );
3106 my $existing_biblionumbers = $sth2->fetchrow;
3109 if ($existing_biblionumbers) {
3110 $result{'__RAW__'}->{"$_"} = $existing_biblionumbers;
3111 my $weight = ( $1 ? $1 : 0 ) + 1;
3112 $result{'__RAW__'}->{"$_"} =~ s/$biblionumber,\Q$title\E\-(\d+);//;
3113 $result{'__RAW__'}->{"$_"} .= "$biblionumber,$title-$weight;";
3115 # create a new ligne for this entry
3117 $dbh->do( 'INSERT INTO nozebra SET server=' . $dbh->quote($server) . ', indexname="__RAW__",value=' . $dbh->quote($_) );
3118 $result{'__RAW__'}->{"$_"} .= "$biblionumber,$title-1;";
3128 =head2 _koha_marc_update_bib_ids
3131 _koha_marc_update_bib_ids($record, $frameworkcode, $biblionumber, $biblioitemnumber);
3133 Internal function to add or update biblionumber and biblioitemnumber to
3138 sub _koha_marc_update_bib_ids {
3139 my ( $record, $frameworkcode, $biblionumber, $biblioitemnumber ) = @_;
3141 # we must add bibnum and bibitemnum in MARC::Record...
3142 # we build the new field with biblionumber and biblioitemnumber
3143 # we drop the original field
3144 # we add the new builded field.
3145 my ( $biblio_tag, $biblio_subfield ) = GetMarcFromKohaField( "biblio.biblionumber", $frameworkcode );
3146 die qq{No biblionumber tag for framework "$frameworkcode"} unless $biblio_tag;
3147 my ( $biblioitem_tag, $biblioitem_subfield ) = GetMarcFromKohaField( "biblioitems.biblioitemnumber", $frameworkcode );
3148 die qq{No biblioitemnumber tag for framework "$frameworkcode"} unless $biblioitem_tag;
3150 if ( $biblio_tag == $biblioitem_tag ) {
3152 # biblionumber & biblioitemnumber are in the same field (can't be <10 as fields <10 have only 1 value)
3153 my $new_field = MARC::Field->new(
3154 $biblio_tag, '', '',
3155 "$biblio_subfield" => $biblionumber,
3156 "$biblioitem_subfield" => $biblioitemnumber
3159 # drop old field and create new one...
3160 my $old_field = $record->field($biblio_tag);
3161 $record->delete_field($old_field) if $old_field;
3162 $record->insert_fields_ordered($new_field);
3165 # biblionumber & biblioitemnumber are in different fields
3167 # deal with biblionumber
3168 my ( $new_field, $old_field );
3169 if ( $biblio_tag < 10 ) {
3170 $new_field = MARC::Field->new( $biblio_tag, $biblionumber );
3172 $new_field = MARC::Field->new( $biblio_tag, '', '', "$biblio_subfield" => $biblionumber );
3175 # drop old field and create new one...
3176 $old_field = $record->field($biblio_tag);
3177 $record->delete_field($old_field) if $old_field;
3178 $record->insert_fields_ordered($new_field);
3180 # deal with biblioitemnumber
3181 if ( $biblioitem_tag < 10 ) {
3182 $new_field = MARC::Field->new( $biblioitem_tag, $biblioitemnumber, );
3184 $new_field = MARC::Field->new( $biblioitem_tag, '', '', "$biblioitem_subfield" => $biblioitemnumber, );
3187 # drop old field and create new one...
3188 $old_field = $record->field($biblioitem_tag);
3189 $record->delete_field($old_field) if $old_field;
3190 $record->insert_fields_ordered($new_field);
3194 =head2 _koha_marc_update_biblioitem_cn_sort
3196 _koha_marc_update_biblioitem_cn_sort($marc, $biblioitem, $frameworkcode);
3198 Given a MARC bib record and the biblioitem hash, update the
3199 subfield that contains a copy of the value of biblioitems.cn_sort.
3203 sub _koha_marc_update_biblioitem_cn_sort {
3205 my $biblioitem = shift;
3206 my $frameworkcode = shift;
3208 my ( $biblioitem_tag, $biblioitem_subfield ) = GetMarcFromKohaField( "biblioitems.cn_sort", $frameworkcode );
3209 return unless $biblioitem_tag;
3211 my ($cn_sort) = GetClassSort( $biblioitem->{'biblioitems.cn_source'}, $biblioitem->{'cn_class'}, $biblioitem->{'cn_item'} );
3213 if ( my $field = $marc->field($biblioitem_tag) ) {
3214 $field->delete_subfield( code => $biblioitem_subfield );
3215 if ( $cn_sort ne '' ) {
3216 $field->add_subfields( $biblioitem_subfield => $cn_sort );
3220 # if we get here, no biblioitem tag is present in the MARC record, so
3221 # we'll create it if $cn_sort is not empty -- this would be
3222 # an odd combination of events, however
3224 $marc->insert_grouped_field( MARC::Field->new( $biblioitem_tag, ' ', ' ', $biblioitem_subfield => $cn_sort ) );
3229 =head2 _koha_add_biblio
3231 my ($biblionumber,$error) = _koha_add_biblio($dbh,$biblioitem);
3233 Internal function to add a biblio ($biblio is a hash with the values)
3237 sub _koha_add_biblio {
3238 my ( $dbh, $biblio, $frameworkcode ) = @_;
3242 # set the series flag
3243 unless (defined $biblio->{'serial'}){
3244 $biblio->{'serial'} = 0;
3245 if ( $biblio->{'seriestitle'} ) { $biblio->{'serial'} = 1 }
3248 my $query = "INSERT INTO biblio
3249 SET frameworkcode = ?,
3260 my $sth = $dbh->prepare($query);
3262 $frameworkcode, $biblio->{'author'}, $biblio->{'title'}, $biblio->{'unititle'}, $biblio->{'notes'},
3263 $biblio->{'serial'}, $biblio->{'seriestitle'}, $biblio->{'copyrightdate'}, $biblio->{'abstract'}
3266 my $biblionumber = $dbh->{'mysql_insertid'};
3267 if ( $dbh->errstr ) {
3268 $error .= "ERROR in _koha_add_biblio $query" . $dbh->errstr;
3274 #warn "LEAVING _koha_add_biblio: ".$biblionumber."\n";
3275 return ( $biblionumber, $error );
3278 =head2 _koha_modify_biblio
3280 my ($biblionumber,$error) == _koha_modify_biblio($dbh,$biblio,$frameworkcode);
3282 Internal function for updating the biblio table
3286 sub _koha_modify_biblio {
3287 my ( $dbh, $biblio, $frameworkcode ) = @_;
3292 SET frameworkcode = ?,
3301 WHERE biblionumber = ?
3304 my $sth = $dbh->prepare($query);
3307 $frameworkcode, $biblio->{'author'}, $biblio->{'title'}, $biblio->{'unititle'}, $biblio->{'notes'},
3308 $biblio->{'serial'}, $biblio->{'seriestitle'}, $biblio->{'copyrightdate'}, $biblio->{'abstract'}, $biblio->{'biblionumber'}
3309 ) if $biblio->{'biblionumber'};
3311 if ( $dbh->errstr || !$biblio->{'biblionumber'} ) {
3312 $error .= "ERROR in _koha_modify_biblio $query" . $dbh->errstr;
3315 return ( $biblio->{'biblionumber'}, $error );
3318 =head2 _koha_modify_biblioitem_nonmarc
3320 my ($biblioitemnumber,$error) = _koha_modify_biblioitem_nonmarc( $dbh, $biblioitem );
3322 Updates biblioitems row except for marc and marcxml, which should be changed
3327 sub _koha_modify_biblioitem_nonmarc {
3328 my ( $dbh, $biblioitem ) = @_;
3331 # re-calculate the cn_sort, it may have changed
3332 my ($cn_sort) = GetClassSort( $biblioitem->{'biblioitems.cn_source'}, $biblioitem->{'cn_class'}, $biblioitem->{'cn_item'} );
3334 my $query = "UPDATE biblioitems
3335 SET biblionumber = ?,
3341 publicationyear = ?,
3345 collectiontitle = ?,
3347 collectionvolume= ?,
3348 editionstatement= ?,
3349 editionresponsibility = ?,
3365 where biblioitemnumber = ?
3367 my $sth = $dbh->prepare($query);
3369 $biblioitem->{'biblionumber'}, $biblioitem->{'volume'}, $biblioitem->{'number'}, $biblioitem->{'itemtype'},
3370 $biblioitem->{'isbn'}, $biblioitem->{'issn'}, $biblioitem->{'publicationyear'}, $biblioitem->{'publishercode'},
3371 $biblioitem->{'volumedate'}, $biblioitem->{'volumedesc'}, $biblioitem->{'collectiontitle'}, $biblioitem->{'collectionissn'},
3372 $biblioitem->{'collectionvolume'}, $biblioitem->{'editionstatement'}, $biblioitem->{'editionresponsibility'}, $biblioitem->{'illus'},
3373 $biblioitem->{'pages'}, $biblioitem->{'bnotes'}, $biblioitem->{'size'}, $biblioitem->{'place'},
3374 $biblioitem->{'lccn'}, $biblioitem->{'url'}, $biblioitem->{'biblioitems.cn_source'}, $biblioitem->{'cn_class'},
3375 $biblioitem->{'cn_item'}, $biblioitem->{'cn_suffix'}, $cn_sort, $biblioitem->{'totalissues'},
3376 $biblioitem->{'ean'}, $biblioitem->{'agerestriction'}, $biblioitem->{'biblioitemnumber'}
3378 if ( $dbh->errstr ) {
3379 $error .= "ERROR in _koha_modify_biblioitem_nonmarc $query" . $dbh->errstr;
3382 return ( $biblioitem->{'biblioitemnumber'}, $error );
3385 =head2 _koha_add_biblioitem
3387 my ($biblioitemnumber,$error) = _koha_add_biblioitem( $dbh, $biblioitem );
3389 Internal function to add a biblioitem
3393 sub _koha_add_biblioitem {
3394 my ( $dbh, $biblioitem ) = @_;
3397 my ($cn_sort) = GetClassSort( $biblioitem->{'biblioitems.cn_source'}, $biblioitem->{'cn_class'}, $biblioitem->{'cn_item'} );
3398 my $query = "INSERT INTO biblioitems SET
3405 publicationyear = ?,
3409 collectiontitle = ?,
3411 collectionvolume= ?,
3412 editionstatement= ?,
3413 editionresponsibility = ?,
3431 my $sth = $dbh->prepare($query);
3433 $biblioitem->{'biblionumber'}, $biblioitem->{'volume'}, $biblioitem->{'number'}, $biblioitem->{'itemtype'},
3434 $biblioitem->{'isbn'}, $biblioitem->{'issn'}, $biblioitem->{'publicationyear'}, $biblioitem->{'publishercode'},
3435 $biblioitem->{'volumedate'}, $biblioitem->{'volumedesc'}, $biblioitem->{'collectiontitle'}, $biblioitem->{'collectionissn'},
3436 $biblioitem->{'collectionvolume'}, $biblioitem->{'editionstatement'}, $biblioitem->{'editionresponsibility'}, $biblioitem->{'illus'},
3437 $biblioitem->{'pages'}, $biblioitem->{'bnotes'}, $biblioitem->{'size'}, $biblioitem->{'place'},
3438 $biblioitem->{'lccn'}, $biblioitem->{'marc'}, $biblioitem->{'url'}, $biblioitem->{'biblioitems.cn_source'},
3439 $biblioitem->{'cn_class'}, $biblioitem->{'cn_item'}, $biblioitem->{'cn_suffix'}, $cn_sort,
3440 $biblioitem->{'totalissues'}, $biblioitem->{'ean'}, $biblioitem->{'agerestriction'}
3442 my $bibitemnum = $dbh->{'mysql_insertid'};
3444 if ( $dbh->errstr ) {
3445 $error .= "ERROR in _koha_add_biblioitem $query" . $dbh->errstr;
3449 return ( $bibitemnum, $error );
3452 =head2 _koha_delete_biblio
3454 $error = _koha_delete_biblio($dbh,$biblionumber);
3456 Internal sub for deleting from biblio table -- also saves to deletedbiblio
3458 C<$dbh> - the database handle
3460 C<$biblionumber> - the biblionumber of the biblio to be deleted
3464 # FIXME: add error handling
3466 sub _koha_delete_biblio {
3467 my ( $dbh, $biblionumber ) = @_;
3469 # get all the data for this biblio
3470 my $sth = $dbh->prepare("SELECT * FROM biblio WHERE biblionumber=?");
3471 $sth->execute($biblionumber);
3473 if ( my $data = $sth->fetchrow_hashref ) {
3475 # save the record in deletedbiblio
3476 # find the fields to save
3477 my $query = "INSERT INTO deletedbiblio SET ";
3479 foreach my $temp ( keys %$data ) {
3480 $query .= "$temp = ?,";
3481 push( @bind, $data->{$temp} );
3484 # replace the last , by ",?)"
3486 my $bkup_sth = $dbh->prepare($query);
3487 $bkup_sth->execute(@bind);
3491 my $sth2 = $dbh->prepare("DELETE FROM biblio WHERE biblionumber=?");
3492 $sth2->execute($biblionumber);
3493 # update the timestamp (Bugzilla 7146)
3494 $sth2= $dbh->prepare("UPDATE deletedbiblio SET timestamp=NOW() WHERE biblionumber=?");
3495 $sth2->execute($biblionumber);
3502 =head2 _koha_delete_biblioitems
3504 $error = _koha_delete_biblioitems($dbh,$biblioitemnumber);
3506 Internal sub for deleting from biblioitems table -- also saves to deletedbiblioitems
3508 C<$dbh> - the database handle
3509 C<$biblionumber> - the biblioitemnumber of the biblioitem to be deleted
3513 # FIXME: add error handling
3515 sub _koha_delete_biblioitems {
3516 my ( $dbh, $biblioitemnumber ) = @_;
3518 # get all the data for this biblioitem
3519 my $sth = $dbh->prepare("SELECT * FROM biblioitems WHERE biblioitemnumber=?");
3520 $sth->execute($biblioitemnumber);
3522 if ( my $data = $sth->fetchrow_hashref ) {
3524 # save the record in deletedbiblioitems
3525 # find the fields to save
3526 my $query = "INSERT INTO deletedbiblioitems SET ";
3528 foreach my $temp ( keys %$data ) {
3529 $query .= "$temp = ?,";
3530 push( @bind, $data->{$temp} );
3533 # replace the last , by ",?)"
3535 my $bkup_sth = $dbh->prepare($query);
3536 $bkup_sth->execute(@bind);
3539 # delete the biblioitem
3540 my $sth2 = $dbh->prepare("DELETE FROM biblioitems WHERE biblioitemnumber=?");
3541 $sth2->execute($biblioitemnumber);
3542 # update the timestamp (Bugzilla 7146)
3543 $sth2= $dbh->prepare("UPDATE deletedbiblioitems SET timestamp=NOW() WHERE biblioitemnumber=?");
3544 $sth2->execute($biblioitemnumber);
3551 =head1 UNEXPORTED FUNCTIONS
3553 =head2 ModBiblioMarc
3555 &ModBiblioMarc($newrec,$biblionumber,$frameworkcode);
3557 Add MARC data for a biblio to koha
3559 Function exported, but should NOT be used, unless you really know what you're doing
3564 # pass the MARC::Record to this function, and it will create the records in
3566 my ( $record, $biblionumber, $frameworkcode ) = @_;
3568 # Clone record as it gets modified
3569 $record = $record->clone();
3570 my $dbh = C4::Context->dbh;
3571 my @fields = $record->fields();
3572 if ( !$frameworkcode ) {
3573 $frameworkcode = "";
3575 my $sth = $dbh->prepare("UPDATE biblio SET frameworkcode=? WHERE biblionumber=?");
3576 $sth->execute( $frameworkcode, $biblionumber );
3578 my $encoding = C4::Context->preference("marcflavour");
3580 # deal with UNIMARC field 100 (encoding) : create it if needed & set encoding to unicode
3581 if ( $encoding eq "UNIMARC" ) {
3582 my $string = $record->subfield( 100, "a" );
3583 if ( ($string) && ( length( $record->subfield( 100, "a" ) ) == 36 ) ) {
3584 my $f100 = $record->field(100);
3585 $record->delete_field($f100);
3587 $string = POSIX::strftime( "%Y%m%d", localtime );
3589 $string = sprintf( "%-*s", 35, $string );
3591 substr( $string, 22, 6, "frey50" );
3592 unless ( $record->subfield( 100, "a" ) ) {
3593 $record->insert_fields_ordered( MARC::Field->new( 100, "", "", "a" => $string ) );
3597 #enhancement 5374: update transaction date (005) for marc21/unimarc
3598 if($encoding =~ /MARC21|UNIMARC/) {
3599 my @a= (localtime) [5,4,3,2,1,0]; $a[0]+=1900; $a[1]++;
3600 # YY MM DD HH MM SS (update year and month)
3601 my $f005= $record->field('005');
3602 $f005->update(sprintf("%4d%02d%02d%02d%02d%04.1f",@a)) if $f005;
3606 if ( C4::Context->preference("NoZebra") ) {
3608 # only NoZebra indexing needs to have
3609 # the previous version of the record
3610 $oldRecord = GetMarcBiblio($biblionumber);
3612 $sth = $dbh->prepare("UPDATE biblioitems SET marc=?,marcxml=? WHERE biblionumber=?");
3613 $sth->execute( $record->as_usmarc(), $record->as_xml_record($encoding), $biblionumber );
3615 ModZebra( $biblionumber, "specialUpdate", "biblioserver", $oldRecord, $record );
3616 return $biblionumber;
3619 =head2 get_biblio_authorised_values
3621 find the types and values for all authorised values assigned to this biblio.
3625 MARC::Record of the bib
3627 returns: a hashref mapping the authorised value to the value set for this biblionumber
3629 $authorised_values = {
3630 'Scent' => 'flowery',
3631 'Audience' => 'Young Adult',
3632 'itemtypes' => 'SER',
3635 Notes: forlibrarian should probably be passed in, and called something different.
3639 sub get_biblio_authorised_values {
3640 my $biblionumber = shift;
3643 my $forlibrarian = 1; # are we in staff or opac?
3644 my $frameworkcode = GetFrameworkCode($biblionumber);
3646 my $authorised_values;
3648 my $tagslib = GetMarcStructure( $forlibrarian, $frameworkcode )
3649 or return $authorised_values;
3651 # assume that these entries in the authorised_value table are bibliolevel.
3652 # ones that start with 'item%' are item level.
3653 my $query = q(SELECT distinct authorised_value, kohafield
3654 FROM marc_subfield_structure
3655 WHERE authorised_value !=''
3656 AND (kohafield like 'biblio%'
3657 OR kohafield like '') );
3658 my $bibliolevel_authorised_values = C4::Context->dbh->selectall_hashref( $query, 'authorised_value' );
3660 foreach my $tag ( keys(%$tagslib) ) {
3661 foreach my $subfield ( keys( %{ $tagslib->{$tag} } ) ) {
3663 # warn "checking $subfield. type is: " . ref $tagslib->{ $tag }{ $subfield };
3664 if ( 'HASH' eq ref $tagslib->{$tag}{$subfield} ) {
3665 if ( defined $tagslib->{$tag}{$subfield}{'authorised_value'} && exists $bibliolevel_authorised_values->{ $tagslib->{$tag}{$subfield}{'authorised_value'} } ) {
3666 if ( defined $record->field($tag) ) {
3667 my $this_subfield_value = $record->field($tag)->subfield($subfield);
3668 if ( defined $this_subfield_value ) {
3669 $authorised_values->{ $tagslib->{$tag}{$subfield}{'authorised_value'} } = $this_subfield_value;
3677 # warn ( Data::Dumper->Dump( [ $authorised_values ], [ 'authorised_values' ] ) );
3678 return $authorised_values;
3681 =head2 CountBiblioInOrders
3684 $count = &CountBiblioInOrders( $biblionumber);
3688 This function return count of biblios in orders with $biblionumber
3692 sub CountBiblioInOrders {
3693 my ($biblionumber) = @_;
3694 my $dbh = C4::Context->dbh;
3695 my $query = "SELECT count(*)
3697 WHERE biblionumber=? AND (datecancellationprinted IS NULL OR datecancellationprinted='0000-00-00')";
3698 my $sth = $dbh->prepare($query);
3699 $sth->execute($biblionumber);
3700 my $count = $sth->fetchrow;
3704 =head2 GetSubscriptionsId
3707 $subscriptions = &GetSubscriptionsId($biblionumber);
3711 This function return an array of subscriptionid with $biblionumber
3715 sub GetSubscriptionsId {
3716 my ($biblionumber) = @_;
3717 my $dbh = C4::Context->dbh;
3718 my $query = "SELECT subscriptionid
3720 WHERE biblionumber=?";
3721 my $sth = $dbh->prepare($query);
3722 $sth->execute($biblionumber);
3723 my @subscriptions = $sth->fetchrow_array;
3724 return (@subscriptions);
3730 $holds = &GetHolds($biblionumber);
3734 This function return the count of holds with $biblionumber
3739 my ($biblionumber) = @_;
3740 my $dbh = C4::Context->dbh;
3741 my $query = "SELECT count(*)
3743 WHERE biblionumber=?";
3744 my $sth = $dbh->prepare($query);
3745 $sth->execute($biblionumber);
3746 my $holds = $sth->fetchrow;
3750 =head2 prepare_host_field
3752 $marcfield = prepare_host_field( $hostbiblioitem, $marcflavour );
3753 Generate the host item entry for an analytic child entry
3757 sub prepare_host_field {
3758 my ( $hostbiblio, $marcflavour ) = @_;
3759 $marcflavour ||= C4::Context->preference('marcflavour');
3760 my $host = GetMarcBiblio($hostbiblio);
3761 # unfortunately as_string does not 'do the right thing'
3762 # if field returns undef
3766 if ( $marcflavour eq 'MARC21' || $marcflavour eq 'NORMARC' ) {
3767 if ( $field = $host->field('100') || $host->field('110') || $host->field('11') ) {
3768 my $s = $field->as_string('ab');
3773 if ( $field = $host->field('245') ) {
3774 my $s = $field->as_string('a');
3779 if ( $field = $host->field('260') ) {
3780 my $s = $field->as_string('abc');
3785 if ( $field = $host->field('240') ) {
3786 my $s = $field->as_string();
3791 if ( $field = $host->field('022') ) {
3792 my $s = $field->as_string('a');
3797 if ( $field = $host->field('020') ) {
3798 my $s = $field->as_string('a');
3803 if ( $field = $host->field('001') ) {
3804 $sfd{w} = $field->data(),;
3806 $host_field = MARC::Field->new( 773, '0', ' ', %sfd );
3809 elsif ( $marcflavour eq 'UNIMARC' ) {
3811 if ( $field = $host->field('700') || $host->field('710') || $host->field('720') ) {
3812 my $s = $field->as_string('ab');
3818 if ( $field = $host->field('200') ) {
3819 my $s = $field->as_string('a');
3824 #place of publicaton
3825 if ( $field = $host->field('210') ) {
3826 my $s = $field->as_string('a');
3831 #date of publication
3832 if ( $field = $host->field('210') ) {
3833 my $s = $field->as_string('d');
3839 if ( $field = $host->field('205') ) {
3840 my $s = $field->as_string();
3846 if ( $field = $host->field('856') ) {
3847 my $s = $field->as_string('u');
3853 if ( $field = $host->field('011') ) {
3854 my $s = $field->as_string('a');
3860 if ( $field = $host->field('010') ) {
3861 my $s = $field->as_string('a');
3866 if ( $field = $host->field('001') ) {
3867 $sfd{0} = $field->data(),;
3869 $host_field = MARC::Field->new( 461, '0', ' ', %sfd );
3876 =head2 UpdateTotalIssues
3878 UpdateTotalIssues($biblionumber, $increase, [$value])
3880 Update the total issue count for a particular bib record.
3884 =item C<$biblionumber> is the biblionumber of the bib to update
3886 =item C<$increase> is the amount to increase (or decrease) the total issues count by
3888 =item C<$value> is the absolute value that total issues count should be set to. If provided, C<$increase> is ignored.
3894 sub UpdateTotalIssues {
3895 my ($biblionumber, $increase, $value) = @_;
3898 my $data = GetBiblioData($biblionumber);
3900 if (defined $value) {
3901 $totalissues = $value;
3903 $totalissues = $data->{'totalissues'} + $increase;
3905 my ($totalissuestag, $totalissuessubfield) = GetMarcFromKohaField('biblioitems.totalissues', $data->{'frameworkcode'});
3907 my $record = GetMarcBiblio($biblionumber);
3909 my $field = $record->field($totalissuestag);
3910 if (defined $field) {
3911 $field->update( $totalissuessubfield => $totalissues );
3913 $field = MARC::Field->new($totalissuestag, '0', '0',
3914 $totalissuessubfield => $totalissues);
3915 $record->insert_grouped_field($field);
3918 ModBiblio($record, $biblionumber, $data->{'frameworkcode'});
3924 &RemoveAllNsb($record);
3926 Removes all nsb/nse chars from a record
3933 SetUTF8Flag($record);
3935 foreach my $field ($record->fields()) {
3936 if ($field->is_control_field()) {
3937 $field->update(nsb_clean($field->data()));
3939 my @subfields = $field->subfields();
3941 foreach my $subfield (@subfields) {
3942 push @new_subfields, $subfield->[0] => nsb_clean($subfield->[1]);
3944 if (scalar(@new_subfields) > 0) {
3947 $new_field = MARC::Field->new(
3949 $field->indicator(1),
3950 $field->indicator(2),
3955 warn "error in RemoveAllNsb : $@";
3957 $field->replace_with($new_field);
3973 Koha Development Team <http://koha-community.org/>
3975 Paul POULAIN paul.poulain@free.fr
3977 Joshua Ferraro jmf@liblime.com