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
93 &GetMarcSubfieldStructureFromKohaField
104 # To modify something
113 # To delete something
118 # To link headings in a bib record
119 # to authority records.
122 &LinkBibHeadingsToAuthorities
126 # those functions are exported but should not be used
127 # they are usefull is few circumstances, so are exported.
128 # but don't use them unless you're a core developer ;-)
136 &TransformHtmlToMarc2
145 if (C4::Context->ismemcached) {
146 require Memoize::Memcached;
147 import Memoize::Memcached qw(memoize_memcached);
149 memoize_memcached( 'GetMarcStructure',
150 memcached => C4::Context->memcached);
156 C4::Biblio - cataloging management functions
160 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:
164 =item 1. in the biblio,biblioitems,items, etc tables, which are limited to a one-to-one mapping to underlying MARC data
166 =item 2. as raw MARC in the Zebra index and storage engine
168 =item 3. as raw MARC the biblioitems.marc and biblioitems.marcxml
172 In the 3.0 version of Koha, the authoritative record-level information is in biblioitems.marcxml
174 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.
178 =item 1. Compared with MySQL, Zebra is slow to update an index for small data changes -- especially for proc-intensive operations like circulation
180 =item 2. Zebra's index has been known to crash and a backup of the data is necessary to rebuild it in such cases
184 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:
188 =item 1. Add*/Mod*/Del*/ - high-level external functions suitable for being called from external scripts to manage the collection
190 =item 2. _koha_* - low-level internal functions for managing the koha tables
192 =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.
194 =item 4. Zebra functions used to update the Zebra index
196 =item 5. internal helper functions such as char_decode, checkitems, etc. Some of these probably belong in Koha.pm
200 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 :
204 =item 1. save datas in biblio and biblioitems table, that gives us a biblionumber and a biblioitemnumber
206 =item 2. add the biblionumber and biblioitemnumber into the MARC records
208 =item 3. save the marc record
212 When dealing with items, we must :
216 =item 1. save the item in items table, that gives us an itemnumber
218 =item 2. add the itemnumber to the item MARC field
220 =item 3. overwrite the MARC record (with the added item) into biblioitems.marc(xml)
222 When modifying a biblio or an item, the behaviour is quite similar.
226 =head1 EXPORTED FUNCTIONS
230 ($biblionumber,$biblioitemnumber) = AddBiblio($record,$frameworkcode);
232 Exported function (core API) for adding a new biblio to koha.
234 The first argument is a C<MARC::Record> object containing the
235 bib to add, while the second argument is the desired MARC
238 This function also accepts a third, optional argument: a hashref
239 to additional options. The only defined option is C<defer_marc_save>,
240 which if present and mapped to a true value, causes C<AddBiblio>
241 to omit the call to save the MARC in C<bibilioitems.marc>
242 and C<biblioitems.marcxml> This option is provided B<only>
243 for the use of scripts such as C<bulkmarcimport.pl> that may need
244 to do some manipulation of the MARC record for item parsing before
245 saving it and which cannot afford the performance hit of saving
246 the MARC record twice. Consequently, do not use that option
247 unless you can guarantee that C<ModBiblioMarc> will be called.
253 my $frameworkcode = shift;
254 my $options = @_ ? shift : undef;
255 my $defer_marc_save = 0;
256 if ( defined $options and exists $options->{'defer_marc_save'} and $options->{'defer_marc_save'} ) {
257 $defer_marc_save = 1;
260 my ( $biblionumber, $biblioitemnumber, $error );
261 my $dbh = C4::Context->dbh;
263 # transform the data into koha-table style data
264 SetUTF8Flag($record);
265 my $olddata = TransformMarcToKoha( $dbh, $record, $frameworkcode );
266 ( $biblionumber, $error ) = _koha_add_biblio( $dbh, $olddata, $frameworkcode );
267 $olddata->{'biblionumber'} = $biblionumber;
268 ( $biblioitemnumber, $error ) = _koha_add_biblioitem( $dbh, $olddata );
270 _koha_marc_update_bib_ids( $record, $frameworkcode, $biblionumber, $biblioitemnumber );
272 # update MARC subfield that stores biblioitems.cn_sort
273 _koha_marc_update_biblioitem_cn_sort( $record, $olddata, $frameworkcode );
276 ModBiblioMarc( $record, $biblionumber, $frameworkcode ) unless $defer_marc_save;
278 # update OAI-PMH sets
279 if(C4::Context->preference("OAI-PMH:AutoUpdateSets")) {
280 C4::OAI::Sets::UpdateOAISetsBiblio($biblionumber, $record);
283 logaction( "CATALOGUING", "ADD", $biblionumber, "biblio" ) if C4::Context->preference("CataloguingLog");
284 return ( $biblionumber, $biblioitemnumber );
289 ModBiblio( $record,$biblionumber,$frameworkcode);
291 Replace an existing bib record identified by C<$biblionumber>
292 with one supplied by the MARC::Record object C<$record>. The embedded
293 item, biblioitem, and biblionumber fields from the previous
294 version of the bib record replace any such fields of those tags that
295 are present in C<$record>. Consequently, ModBiblio() is not
296 to be used to try to modify item records.
298 C<$frameworkcode> specifies the MARC framework to use
299 when storing the modified bib record; among other things,
300 this controls how MARC fields get mapped to display columns
301 in the C<biblio> and C<biblioitems> tables, as well as
302 which fields are used to store embedded item, biblioitem,
303 and biblionumber data for indexing.
308 my ( $record, $biblionumber, $frameworkcode ) = @_;
309 croak "No record" unless $record;
311 if ( C4::Context->preference("CataloguingLog") ) {
312 my $newrecord = GetMarcBiblio($biblionumber);
313 logaction( "CATALOGUING", "MODIFY", $biblionumber, "BEFORE=>" . $newrecord->as_formatted );
316 # Cleaning up invalid fields must be done early or SetUTF8Flag is liable to
317 # throw an exception which probably won't be handled.
318 foreach my $field ($record->fields()) {
319 if (! $field->is_control_field()) {
320 if (scalar($field->subfields()) == 0 || (scalar($field->subfields()) == 1 && $field->subfield('9'))) {
321 $record->delete_field($field);
326 SetUTF8Flag($record);
327 my $dbh = C4::Context->dbh;
329 $frameworkcode = "" if !$frameworkcode || $frameworkcode eq "Default"; # XXX
331 _strip_item_fields($record, $frameworkcode);
333 # update biblionumber and biblioitemnumber in MARC
334 # FIXME - this is assuming a 1 to 1 relationship between
335 # biblios and biblioitems
336 my $sth = $dbh->prepare("select biblioitemnumber from biblioitems where biblionumber=?");
337 $sth->execute($biblionumber);
338 my ($biblioitemnumber) = $sth->fetchrow;
340 _koha_marc_update_bib_ids( $record, $frameworkcode, $biblionumber, $biblioitemnumber );
342 # load the koha-table data object
343 my $oldbiblio = TransformMarcToKoha( $dbh, $record, $frameworkcode );
345 # update MARC subfield that stores biblioitems.cn_sort
346 _koha_marc_update_biblioitem_cn_sort( $record, $oldbiblio, $frameworkcode );
348 # update the MARC record (that now contains biblio and items) with the new record data
349 &ModBiblioMarc( $record, $biblionumber, $frameworkcode );
351 # modify the other koha tables
352 _koha_modify_biblio( $dbh, $oldbiblio, $frameworkcode );
353 _koha_modify_biblioitem_nonmarc( $dbh, $oldbiblio );
355 # update OAI-PMH sets
356 if(C4::Context->preference("OAI-PMH:AutoUpdateSets")) {
357 C4::OAI::Sets::UpdateOAISetsBiblio($biblionumber, $record);
363 =head2 _strip_item_fields
365 _strip_item_fields($record, $frameworkcode)
367 Utility routine to remove item tags from a
372 sub _strip_item_fields {
374 my $frameworkcode = shift;
375 # get the items before and append them to the biblio before updating the record, atm we just have the biblio
376 my ( $itemtag, $itemsubfield ) = GetMarcFromKohaField( "items.itemnumber", $frameworkcode );
378 # delete any item fields from incoming record to avoid
379 # duplication or incorrect data - use AddItem() or ModItem()
381 foreach my $field ( $record->field($itemtag) ) {
382 $record->delete_field($field);
386 =head2 ModBiblioframework
388 ModBiblioframework($biblionumber,$frameworkcode);
390 Exported function to modify a biblio framework
394 sub ModBiblioframework {
395 my ( $biblionumber, $frameworkcode ) = @_;
396 my $dbh = C4::Context->dbh;
397 my $sth = $dbh->prepare( "UPDATE biblio SET frameworkcode=? WHERE biblionumber=?" );
398 $sth->execute( $frameworkcode, $biblionumber );
404 my $error = &DelBiblio($biblionumber);
406 Exported function (core API) for deleting a biblio in koha.
407 Deletes biblio record from Zebra and Koha tables (biblio,biblioitems,items)
408 Also backs it up to deleted* tables
409 Checks to make sure there are not issues on any of the items
411 C<$error> : undef unless an error occurs
416 my ($biblionumber) = @_;
417 my $dbh = C4::Context->dbh;
418 my $error; # for error handling
420 # First make sure this biblio has no items attached
421 my $sth = $dbh->prepare("SELECT itemnumber FROM items WHERE biblionumber=?");
422 $sth->execute($biblionumber);
423 if ( my $itemnumber = $sth->fetchrow ) {
425 # Fix this to use a status the template can understand
426 $error .= "This Biblio has items attached, please delete them first before deleting this biblio ";
429 return $error if $error;
431 # We delete attached subscriptions
433 my $subscriptions = C4::Serials::GetFullSubscriptionsFromBiblionumber($biblionumber);
434 foreach my $subscription (@$subscriptions) {
435 C4::Serials::DelSubscription( $subscription->{subscriptionid} );
438 # We delete any existing holds
439 require C4::Reserves;
440 my ($count, $reserves) = C4::Reserves::GetReservesFromBiblionumber($biblionumber);
441 foreach my $res ( @$reserves ) {
442 C4::Reserves::CancelReserve( $res->{'biblionumber'}, $res->{'itemnumber'}, $res->{'borrowernumber'} );
445 # Delete in Zebra. Be careful NOT to move this line after _koha_delete_biblio
446 # for at least 2 reasons :
447 # - we need to read the biblio if NoZebra is set (to remove it from the indexes
448 # - if something goes wrong, the biblio may be deleted from Koha but not from zebra
449 # 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)
451 if ( C4::Context->preference("NoZebra") ) {
453 # only NoZebra indexing needs to have
454 # the previous version of the record
455 $oldRecord = GetMarcBiblio($biblionumber);
457 ModZebra( $biblionumber, "recordDelete", "biblioserver", $oldRecord, undef );
459 # delete biblioitems and items from Koha tables and save in deletedbiblioitems,deleteditems
460 $sth = $dbh->prepare("SELECT biblioitemnumber FROM biblioitems WHERE biblionumber=?");
461 $sth->execute($biblionumber);
462 while ( my $biblioitemnumber = $sth->fetchrow ) {
464 # delete this biblioitem
465 $error = _koha_delete_biblioitems( $dbh, $biblioitemnumber );
466 return $error if $error;
469 # delete biblio from Koha tables and save in deletedbiblio
470 # must do this *after* _koha_delete_biblioitems, otherwise
471 # delete cascade will prevent deletedbiblioitems rows
472 # from being generated by _koha_delete_biblioitems
473 $error = _koha_delete_biblio( $dbh, $biblionumber );
475 logaction( "CATALOGUING", "DELETE", $biblionumber, "" ) if C4::Context->preference("CataloguingLog");
481 =head2 BiblioAutoLink
483 my $headings_linked = BiblioAutoLink($record, $frameworkcode)
485 Automatically links headings in a bib record to authorities.
491 my $frameworkcode = shift;
492 my ( $num_headings_changed, %results );
495 "C4::Linker::" . ( C4::Context->preference("LinkerModule") || 'Default' );
496 unless ( can_load( modules => { $linker_module => undef } ) ) {
497 $linker_module = 'C4::Linker::Default';
498 unless ( can_load( modules => { $linker_module => undef } ) ) {
503 my $linker = $linker_module->new(
504 { 'options' => C4::Context->preference("LinkerOptions") } );
505 my ( $headings_changed, undef ) =
506 LinkBibHeadingsToAuthorities( $linker, $record, $frameworkcode, C4::Context->preference("CatalogModuleRelink") || '' );
507 # By default we probably don't want to relink things when cataloging
508 return $headings_changed;
511 =head2 LinkBibHeadingsToAuthorities
513 my $num_headings_changed, %results = LinkBibHeadingsToAuthorities($linker, $marc, $frameworkcode, [$allowrelink]);
515 Links bib headings to authority records by checking
516 each authority-controlled field in the C<MARC::Record>
517 object C<$marc>, looking for a matching authority record,
518 and setting the linking subfield $9 to the ID of that
521 If $allowrelink is false, existing authids will never be
522 replaced, regardless of the values of LinkerKeepStale and
525 Returns the number of heading links changed in the
530 sub LinkBibHeadingsToAuthorities {
533 my $frameworkcode = shift;
534 my $allowrelink = shift;
537 require C4::AuthoritiesMarc;
539 $allowrelink = 1 unless defined $allowrelink;
540 my $num_headings_changed = 0;
541 foreach my $field ( $bib->fields() ) {
542 my $heading = C4::Heading->new_from_bib_field( $field, $frameworkcode );
543 next unless defined $heading;
546 my $current_link = $field->subfield('9');
548 if ( defined $current_link && (!$allowrelink || !C4::Context->preference('LinkerRelink')) )
550 $results{'linked'}->{ $heading->display_form() }++;
554 my ( $authid, $fuzzy ) = $linker->get_link($heading);
556 $results{ $fuzzy ? 'fuzzy' : 'linked' }
557 ->{ $heading->display_form() }++;
558 next if defined $current_link and $current_link == $authid;
560 $field->delete_subfield( code => '9' ) if defined $current_link;
561 $field->add_subfields( '9', $authid );
562 $num_headings_changed++;
565 if ( defined $current_link
566 && (!$allowrelink || C4::Context->preference('LinkerKeepStale')) )
568 $results{'fuzzy'}->{ $heading->display_form() }++;
570 elsif ( C4::Context->preference('AutoCreateAuthorities') ) {
571 if ( _check_valid_auth_link( $current_link, $field ) ) {
572 $results{'linked'}->{ $heading->display_form() }++;
576 C4::AuthoritiesMarc::GetAuthType( $heading->auth_type() );
577 my $marcrecordauth = MARC::Record->new();
578 if ( C4::Context->preference('marcflavour') eq 'MARC21' ) {
579 $marcrecordauth->leader(' nz a22 o 4500');
580 SetMarcUnicodeFlag( $marcrecordauth, 'MARC21' );
582 $field->delete_subfield( code => '9' )
583 if defined $current_link;
585 MARC::Field->new( $authtypedata->{auth_tag_to_report},
586 '', '', "a" => "" . $field->subfield('a') );
588 $authfield->add_subfields( $_->[0] => $_->[1] )
589 if ( $_->[0] =~ /[A-z]/ && $_->[0] ne "a" )
590 } $field->subfields();
591 $marcrecordauth->insert_fields_ordered($authfield);
593 # bug 2317: ensure new authority knows it's using UTF-8; currently
594 # only need to do this for MARC21, as MARC::Record->as_xml_record() handles
595 # automatically for UNIMARC (by not transcoding)
596 # FIXME: AddAuthority() instead should simply explicitly require that the MARC::Record
597 # use UTF-8, but as of 2008-08-05, did not want to introduce that kind
598 # of change to a core API just before the 3.0 release.
600 if ( C4::Context->preference('marcflavour') eq 'MARC21' ) {
601 $marcrecordauth->insert_fields_ordered(
604 'a' => "Machine generated authority record."
608 $bib->author() . ", "
609 . $bib->title_proper() . ", "
610 . $bib->publication_date() . " ";
611 $cite =~ s/^[\s\,]*//;
612 $cite =~ s/[\s\,]*$//;
615 . C4::Context->preference('MARCOrgCode') . ")"
616 . $bib->subfield( '999', 'c' ) . ": "
618 $marcrecordauth->insert_fields_ordered(
619 MARC::Field->new( '670', '', '', 'a' => $cite ) );
622 # warn "AUTH RECORD ADDED : ".$marcrecordauth->as_formatted;
625 C4::AuthoritiesMarc::AddAuthority( $marcrecordauth, '',
626 $heading->auth_type() );
627 $field->add_subfields( '9', $authid );
628 $num_headings_changed++;
629 $results{'added'}->{ $heading->display_form() }++;
632 elsif ( defined $current_link ) {
633 if ( _check_valid_auth_link( $current_link, $field ) ) {
634 $results{'linked'}->{ $heading->display_form() }++;
637 $field->delete_subfield( code => '9' );
638 $num_headings_changed++;
639 $results{'unlinked'}->{ $heading->display_form() }++;
643 $results{'unlinked'}->{ $heading->display_form() }++;
648 return $num_headings_changed, \%results;
651 =head2 _check_valid_auth_link
653 if ( _check_valid_auth_link($authid, $field) ) {
657 Check whether the specified heading-auth link is valid without reference
658 to Zebra/Solr. Ideally this code would be in C4::Heading, but that won't be
659 possible until we have de-cycled C4::AuthoritiesMarc, so this is the
664 sub _check_valid_auth_link {
665 my ( $authid, $field ) = @_;
667 require C4::AuthoritiesMarc;
669 my $authorized_heading =
670 C4::AuthoritiesMarc::GetAuthorizedHeading( { 'authid' => $authid } );
672 return ($field->as_string('abcdefghijklmnopqrstuvwxyz') eq $authorized_heading);
675 =head2 GetRecordValue
677 my $values = GetRecordValue($field, $record, $frameworkcode);
679 Get MARC fields from a keyword defined in fieldmapping table.
684 my ( $field, $record, $frameworkcode ) = @_;
685 my $dbh = C4::Context->dbh;
687 my $sth = $dbh->prepare('SELECT fieldcode, subfieldcode FROM fieldmapping WHERE frameworkcode = ? AND field = ?');
688 $sth->execute( $frameworkcode, $field );
692 while ( my $row = $sth->fetchrow_hashref ) {
693 foreach my $field ( $record->field( $row->{fieldcode} ) ) {
694 if ( ( $row->{subfieldcode} ne "" && $field->subfield( $row->{subfieldcode} ) ) ) {
695 foreach my $subfield ( $field->subfield( $row->{subfieldcode} ) ) {
696 push @result, { 'subfield' => $subfield };
699 } elsif ( $row->{subfieldcode} eq "" ) {
700 push @result, { 'subfield' => $field->as_string() };
708 =head2 SetFieldMapping
710 SetFieldMapping($framework, $field, $fieldcode, $subfieldcode);
712 Set a Field to MARC mapping value, if it already exists we don't add a new one.
716 sub SetFieldMapping {
717 my ( $framework, $field, $fieldcode, $subfieldcode ) = @_;
718 my $dbh = C4::Context->dbh;
720 my $sth = $dbh->prepare('SELECT * FROM fieldmapping WHERE fieldcode = ? AND subfieldcode = ? AND frameworkcode = ? AND field = ?');
721 $sth->execute( $fieldcode, $subfieldcode, $framework, $field );
722 if ( not $sth->fetchrow_hashref ) {
724 $sth = $dbh->prepare('INSERT INTO fieldmapping (fieldcode, subfieldcode, frameworkcode, field) VALUES(?,?,?,?)');
726 $sth->execute( $fieldcode, $subfieldcode, $framework, $field );
730 =head2 DeleteFieldMapping
732 DeleteFieldMapping($id);
734 Delete a field mapping from an $id.
738 sub DeleteFieldMapping {
740 my $dbh = C4::Context->dbh;
742 my $sth = $dbh->prepare('DELETE FROM fieldmapping WHERE id = ?');
746 =head2 GetFieldMapping
748 GetFieldMapping($frameworkcode);
750 Get all field mappings for a specified frameworkcode
754 sub GetFieldMapping {
755 my ($framework) = @_;
756 my $dbh = C4::Context->dbh;
758 my $sth = $dbh->prepare('SELECT * FROM fieldmapping where frameworkcode = ?');
759 $sth->execute($framework);
762 while ( my $row = $sth->fetchrow_hashref ) {
770 $data = &GetBiblioData($biblionumber);
772 Returns information about the book with the given biblionumber.
773 C<&GetBiblioData> returns a reference-to-hash. The keys are the fields in
774 the C<biblio> and C<biblioitems> tables in the
777 In addition, C<$data-E<gt>{subject}> is the list of the book's
778 subjects, separated by C<" , "> (space, comma, space).
779 If there are multiple biblioitems with the given biblionumber, only
780 the first one is considered.
786 my $dbh = C4::Context->dbh;
788 # my $query = C4::Context->preference('item-level_itypes') ?
789 # " SELECT * , biblioitems.notes AS bnotes, biblio.notes
791 # LEFT JOIN biblioitems ON biblio.biblionumber = biblioitems.biblionumber
792 # WHERE biblio.biblionumber = ?
793 # AND biblioitems.biblionumber = biblio.biblionumber
796 my $query = " SELECT * , biblioitems.notes AS bnotes, itemtypes.notforloan as bi_notforloan, biblio.notes
798 LEFT JOIN biblioitems ON biblio.biblionumber = biblioitems.biblionumber
799 LEFT JOIN itemtypes ON biblioitems.itemtype = itemtypes.itemtype
800 WHERE biblio.biblionumber = ?
801 AND biblioitems.biblionumber = biblio.biblionumber ";
803 my $sth = $dbh->prepare($query);
804 $sth->execute($bibnum);
806 $data = $sth->fetchrow_hashref;
810 } # sub GetBiblioData
812 =head2 &GetBiblioItemData
814 $itemdata = &GetBiblioItemData($biblioitemnumber);
816 Looks up the biblioitem with the given biblioitemnumber. Returns a
817 reference-to-hash. The keys are the fields from the C<biblio>,
818 C<biblioitems>, and C<itemtypes> tables in the Koha database, except
819 that C<biblioitems.notes> is given as C<$itemdata-E<gt>{bnotes}>.
824 sub GetBiblioItemData {
825 my ($biblioitemnumber) = @_;
826 my $dbh = C4::Context->dbh;
827 my $query = "SELECT *,biblioitems.notes AS bnotes
828 FROM biblio LEFT JOIN biblioitems on biblio.biblionumber=biblioitems.biblionumber ";
829 unless ( C4::Context->preference('item-level_itypes') ) {
830 $query .= "LEFT JOIN itemtypes on biblioitems.itemtype=itemtypes.itemtype ";
832 $query .= " WHERE biblioitemnumber = ? ";
833 my $sth = $dbh->prepare($query);
835 $sth->execute($biblioitemnumber);
836 $data = $sth->fetchrow_hashref;
839 } # sub &GetBiblioItemData
841 =head2 GetBiblioItemByBiblioNumber
843 NOTE : This function has been copy/paste from C4/Biblio.pm from head before zebra integration.
847 sub GetBiblioItemByBiblioNumber {
848 my ($biblionumber) = @_;
849 my $dbh = C4::Context->dbh;
850 my $sth = $dbh->prepare("Select * FROM biblioitems WHERE biblionumber = ?");
854 $sth->execute($biblionumber);
856 while ( my $data = $sth->fetchrow_hashref ) {
857 push @results, $data;
864 =head2 GetBiblionumberFromItemnumber
869 sub GetBiblionumberFromItemnumber {
870 my ($itemnumber) = @_;
871 my $dbh = C4::Context->dbh;
872 my $sth = $dbh->prepare("Select biblionumber FROM items WHERE itemnumber = ?");
874 $sth->execute($itemnumber);
875 my ($result) = $sth->fetchrow;
879 =head2 GetBiblioFromItemNumber
881 $item = &GetBiblioFromItemNumber($itemnumber,$barcode);
883 Looks up the item with the given itemnumber. if undef, try the barcode.
885 C<&itemnodata> returns a reference-to-hash whose keys are the fields
886 from the C<biblio>, C<biblioitems>, and C<items> tables in the Koha
892 sub GetBiblioFromItemNumber {
893 my ( $itemnumber, $barcode ) = @_;
894 my $dbh = C4::Context->dbh;
897 $sth = $dbh->prepare(
899 LEFT JOIN biblio ON biblio.biblionumber = items.biblionumber
900 LEFT JOIN biblioitems ON biblioitems.biblioitemnumber = items.biblioitemnumber
901 WHERE items.itemnumber = ?"
903 $sth->execute($itemnumber);
905 $sth = $dbh->prepare(
907 LEFT JOIN biblio ON biblio.biblionumber = items.biblionumber
908 LEFT JOIN biblioitems ON biblioitems.biblioitemnumber = items.biblioitemnumber
909 WHERE items.barcode = ?"
911 $sth->execute($barcode);
913 my $data = $sth->fetchrow_hashref;
920 $isbd = &GetISBDView($biblionumber);
922 Return the ISBD view which can be included in opac and intranet
927 my ( $biblionumber, $template ) = @_;
928 my $record = GetMarcBiblio($biblionumber, 1);
929 return unless defined $record;
930 my $itemtype = &GetFrameworkCode($biblionumber);
931 my ( $holdingbrtagf, $holdingbrtagsubf ) = &GetMarcFromKohaField( "items.holdingbranch", $itemtype );
932 my $tagslib = &GetMarcStructure( 1, $itemtype );
934 my $ISBD = C4::Context->preference('isbd');
939 foreach my $isbdfield ( split( /#/, $bloc ) ) {
941 # $isbdfield= /(.?.?.?)/;
942 $isbdfield =~ /(\d\d\d)([^\|])?\|(.*)\|(.*)\|(.*)/;
943 my $fieldvalue = $1 || 0;
944 my $subfvalue = $2 || "";
946 my $analysestring = $4;
949 # warn "==> $1 / $2 / $3 / $4";
950 # my $fieldvalue=substr($isbdfield,0,3);
951 if ( $fieldvalue > 0 ) {
952 my $hasputtextbefore = 0;
953 my @fieldslist = $record->field($fieldvalue);
954 @fieldslist = sort { $a->subfield($holdingbrtagsubf) cmp $b->subfield($holdingbrtagsubf) } @fieldslist if ( $fieldvalue eq $holdingbrtagf );
956 # warn "ERROR IN ISBD DEFINITION at : $isbdfield" unless $fieldvalue;
957 # warn "FV : $fieldvalue";
958 if ( $subfvalue ne "" ) {
959 # OPAC hidden subfield
961 if ( ( $template eq 'opac' )
962 && ( $tagslib->{$fieldvalue}->{$subfvalue}->{'hidden'} || 0 ) > 0 );
963 foreach my $field (@fieldslist) {
964 foreach my $subfield ( $field->subfield($subfvalue) ) {
965 my $calculated = $analysestring;
966 my $tag = $field->tag();
969 my $subfieldvalue = GetAuthorisedValueDesc( $tag, $subfvalue, $subfield, '', $tagslib );
970 my $tagsubf = $tag . $subfvalue;
971 $calculated =~ s/\{(.?.?.?.?)$tagsubf(.*?)\}/$1$subfieldvalue$2\{$1$tagsubf$2\}/g;
972 if ( $template eq "opac" ) { $calculated =~ s#/cgi-bin/koha/[^/]+/([^.]*.pl\?.*)$#opac-$1#g; }
974 # field builded, store the result
975 if ( $calculated && !$hasputtextbefore ) { # put textbefore if not done
976 $blocres .= $textbefore;
977 $hasputtextbefore = 1;
980 # remove punctuation at start
981 $calculated =~ s/^( |;|:|\.|-)*//g;
982 $blocres .= $calculated;
987 $blocres .= $textafter if $hasputtextbefore;
989 foreach my $field (@fieldslist) {
990 my $calculated = $analysestring;
991 my $tag = $field->tag();
994 my @subf = $field->subfields;
995 for my $i ( 0 .. $#subf ) {
996 my $valuecode = $subf[$i][1];
997 my $subfieldcode = $subf[$i][0];
998 # OPAC hidden subfield
1000 if ( ( $template eq 'opac' )
1001 && ( $tagslib->{$fieldvalue}->{$subfieldcode}->{'hidden'} || 0 ) > 0 );
1002 my $subfieldvalue = GetAuthorisedValueDesc( $tag, $subf[$i][0], $subf[$i][1], '', $tagslib );
1003 my $tagsubf = $tag . $subfieldcode;
1005 $calculated =~ s/ # replace all {{}} codes by the value code.
1006 \{\{$tagsubf\}\} # catch the {{actualcode}}
1008 $valuecode # replace by the value code
1011 $calculated =~ s/\{(.?.?.?.?)$tagsubf(.*?)\}/$1$subfieldvalue$2\{$1$tagsubf$2\}/g;
1012 if ( $template eq "opac" ) { $calculated =~ s#/cgi-bin/koha/[^/]+/([^.]*.pl\?.*)$#opac-$1#g; }
1015 # field builded, store the result
1016 if ( $calculated && !$hasputtextbefore ) { # put textbefore if not done
1017 $blocres .= $textbefore;
1018 $hasputtextbefore = 1;
1021 # remove punctuation at start
1022 $calculated =~ s/^( |;|:|\.|-)*//g;
1023 $blocres .= $calculated;
1026 $blocres .= $textafter if $hasputtextbefore;
1029 $blocres .= $isbdfield;
1034 $res =~ s/\{(.*?)\}//g;
1036 $res =~ s/\n/<br\/>/g;
1046 my $biblio = &GetBiblio($biblionumber);
1051 my ($biblionumber) = @_;
1052 my $dbh = C4::Context->dbh;
1053 my $sth = $dbh->prepare("SELECT * FROM biblio WHERE biblionumber = ?");
1056 $sth->execute($biblionumber);
1057 if ( my $data = $sth->fetchrow_hashref ) {
1063 =head2 GetBiblioItemInfosOf
1065 GetBiblioItemInfosOf(@biblioitemnumbers);
1069 sub GetBiblioItemInfosOf {
1070 my @biblioitemnumbers = @_;
1073 SELECT biblioitemnumber,
1077 WHERE biblioitemnumber IN (' . join( ',', @biblioitemnumbers ) . ')
1079 return get_infos_of( $query, 'biblioitemnumber' );
1082 =head1 FUNCTIONS FOR HANDLING MARC MANAGEMENT
1084 =head2 GetMarcStructure
1086 $res = GetMarcStructure($forlibrarian,$frameworkcode);
1088 Returns a reference to a big hash of hash, with the Marc structure for the given frameworkcode
1089 $forlibrarian :if set to 1, the MARC descriptions are the librarians ones, otherwise it's the public (OPAC) ones
1090 $frameworkcode : the framework code to read
1094 # cache for results of GetMarcStructure -- needed
1096 our $marc_structure_cache;
1098 sub GetMarcStructure {
1099 my ( $forlibrarian, $frameworkcode ) = @_;
1100 my $dbh = C4::Context->dbh;
1101 $frameworkcode = "" unless $frameworkcode;
1103 if ( defined $marc_structure_cache and exists $marc_structure_cache->{$forlibrarian}->{$frameworkcode} ) {
1104 return $marc_structure_cache->{$forlibrarian}->{$frameworkcode};
1107 # my $sth = $dbh->prepare(
1108 # "SELECT COUNT(*) FROM marc_tag_structure WHERE frameworkcode=?");
1109 # $sth->execute($frameworkcode);
1110 # my ($total) = $sth->fetchrow;
1111 # $frameworkcode = "" unless ( $total > 0 );
1112 my $sth = $dbh->prepare(
1113 "SELECT tagfield,liblibrarian,libopac,mandatory,repeatable
1114 FROM marc_tag_structure
1115 WHERE frameworkcode=?
1118 $sth->execute($frameworkcode);
1119 my ( $liblibrarian, $libopac, $tag, $res, $tab, $mandatory, $repeatable );
1121 while ( ( $tag, $liblibrarian, $libopac, $mandatory, $repeatable ) = $sth->fetchrow ) {
1122 $res->{$tag}->{lib} = ( $forlibrarian or !$libopac ) ? $liblibrarian : $libopac;
1123 $res->{$tag}->{tab} = "";
1124 $res->{$tag}->{mandatory} = $mandatory;
1125 $res->{$tag}->{repeatable} = $repeatable;
1128 $sth = $dbh->prepare(
1129 "SELECT tagfield,tagsubfield,liblibrarian,libopac,tab,mandatory,repeatable,authorised_value,authtypecode,value_builder,kohafield,seealso,hidden,isurl,link,defaultvalue,maxlength
1130 FROM marc_subfield_structure
1131 WHERE frameworkcode=?
1132 ORDER BY tagfield,tagsubfield
1136 $sth->execute($frameworkcode);
1139 my $authorised_value;
1151 ( $tag, $subfield, $liblibrarian, $libopac, $tab, $mandatory, $repeatable, $authorised_value,
1152 $authtypecode, $value_builder, $kohafield, $seealso, $hidden, $isurl, $link, $defaultvalue,
1157 $res->{$tag}->{$subfield}->{lib} = ( $forlibrarian or !$libopac ) ? $liblibrarian : $libopac;
1158 $res->{$tag}->{$subfield}->{tab} = $tab;
1159 $res->{$tag}->{$subfield}->{mandatory} = $mandatory;
1160 $res->{$tag}->{$subfield}->{repeatable} = $repeatable;
1161 $res->{$tag}->{$subfield}->{authorised_value} = $authorised_value;
1162 $res->{$tag}->{$subfield}->{authtypecode} = $authtypecode;
1163 $res->{$tag}->{$subfield}->{value_builder} = $value_builder;
1164 $res->{$tag}->{$subfield}->{kohafield} = $kohafield;
1165 $res->{$tag}->{$subfield}->{seealso} = $seealso;
1166 $res->{$tag}->{$subfield}->{hidden} = $hidden;
1167 $res->{$tag}->{$subfield}->{isurl} = $isurl;
1168 $res->{$tag}->{$subfield}->{'link'} = $link;
1169 $res->{$tag}->{$subfield}->{defaultvalue} = $defaultvalue;
1170 $res->{$tag}->{$subfield}->{maxlength} = $maxlength;
1173 $marc_structure_cache->{$forlibrarian}->{$frameworkcode} = $res;
1178 =head2 GetUsedMarcStructure
1180 The same function as GetMarcStructure except it just takes field
1181 in tab 0-9. (used field)
1183 my $results = GetUsedMarcStructure($frameworkcode);
1185 C<$results> is a ref to an array which each case containts a ref
1186 to a hash which each keys is the columns from marc_subfield_structure
1188 C<$frameworkcode> is the framework code.
1192 sub GetUsedMarcStructure {
1193 my $frameworkcode = shift || '';
1196 FROM marc_subfield_structure
1198 AND frameworkcode = ?
1199 ORDER BY tagfield, tagsubfield
1201 my $sth = C4::Context->dbh->prepare($query);
1202 $sth->execute($frameworkcode);
1203 return $sth->fetchall_arrayref( {} );
1206 =head2 GetMarcFromKohaField
1208 ($MARCfield,$MARCsubfield)=GetMarcFromKohaField($kohafield,$frameworkcode);
1210 Returns the MARC fields & subfields mapped to the koha field
1211 for the given frameworkcode or default framework if $frameworkcode is missing
1215 sub GetMarcFromKohaField {
1216 my $kohafield = shift;
1217 my $frameworkcode = shift || '';
1218 return (0, undef) unless $kohafield;
1219 my $relations = C4::Context->marcfromkohafield;
1220 if ( my $mf = $relations->{$frameworkcode}->{$kohafield} ) {
1226 =head2 GetMarcSubfieldStructureFromKohaField
1228 my $subfield_structure = &GetMarcSubfieldStructureFromKohaField($kohafield, $frameworkcode);
1230 Returns a hashref where keys are marc_subfield_structure column names for the
1231 row where kohafield=$kohafield for the given framework code.
1233 $frameworkcode is optional. If not given, then the default framework is used.
1237 sub GetMarcSubfieldStructureFromKohaField {
1238 my ($kohafield, $frameworkcode) = @_;
1240 return undef unless $kohafield;
1241 $frameworkcode //= '';
1243 my $dbh = C4::Context->dbh;
1246 FROM marc_subfield_structure
1248 AND frameworkcode = ?
1250 my $sth = $dbh->prepare($query);
1251 $sth->execute($kohafield, $frameworkcode);
1252 my $result = $sth->fetchrow_hashref;
1258 =head2 GetMarcBiblio
1260 my $record = GetMarcBiblio($biblionumber, [$embeditems]);
1262 Returns MARC::Record representing bib identified by
1263 C<$biblionumber>. If no bib exists, returns undef.
1264 C<$embeditems>. If set to true, items data are included.
1265 The MARC record contains biblio data, and items data if $embeditems is set to true.
1270 my $biblionumber = shift;
1271 my $embeditems = shift || 0;
1272 my $dbh = C4::Context->dbh;
1273 my $sth = $dbh->prepare("SELECT marcxml FROM biblioitems WHERE biblionumber=? ");
1274 $sth->execute($biblionumber);
1275 my $row = $sth->fetchrow_hashref;
1276 my $marcxml = StripNonXmlChars( $row->{'marcxml'} );
1277 MARC::File::XML->default_record_format( C4::Context->preference('marcflavour') );
1278 my $record = MARC::Record->new();
1281 $record = eval { MARC::Record::new_from_xml( $marcxml, "utf8", C4::Context->preference('marcflavour') ) };
1282 if ($@) { warn " problem with :$biblionumber : $@ \n$marcxml"; }
1283 return unless $record;
1285 C4::Biblio::_koha_marc_update_bib_ids($record, '', $biblionumber, $biblionumber);
1286 C4::Biblio::EmbedItemsInMarcBiblio($record, $biblionumber) if ($embeditems);
1296 my $marcxml = GetXmlBiblio($biblionumber);
1298 Returns biblioitems.marcxml of the biblionumber passed in parameter.
1299 The XML should only contain biblio information (item information is no longer stored in marcxml field)
1304 my ($biblionumber) = @_;
1305 my $dbh = C4::Context->dbh;
1306 my $sth = $dbh->prepare("SELECT marcxml FROM biblioitems WHERE biblionumber=? ");
1307 $sth->execute($biblionumber);
1308 my ($marcxml) = $sth->fetchrow;
1312 =head2 GetCOinSBiblio
1314 my $coins = GetCOinSBiblio($record);
1316 Returns the COinS (a span) which can be included in a biblio record
1320 sub GetCOinSBiblio {
1323 # get the coin format
1327 my $pos7 = substr $record->leader(), 7, 1;
1328 my $pos6 = substr $record->leader(), 6, 1;
1331 my ( $aulast, $aufirst ) = ( '', '' );
1340 my $titletype = 'b';
1342 # For the purposes of generating COinS metadata, LDR/06-07 can be
1343 # considered the same for UNIMARC and MARC21
1348 'b' => 'manuscript',
1350 'd' => 'manuscript',
1354 'i' => 'audioRecording',
1355 'j' => 'audioRecording',
1358 'm' => 'computerProgram',
1363 'a' => 'journalArticle',
1367 $genre = $fmts6->{$pos6} ? $fmts6->{$pos6} : 'book';
1369 if ( $genre eq 'book' ) {
1370 $genre = $fmts7->{$pos7} if $fmts7->{$pos7};
1373 ##### We must transform mtx to a valable mtx and document type ####
1374 if ( $genre eq 'book' ) {
1376 } elsif ( $genre eq 'journal' ) {
1379 } elsif ( $genre eq 'journalArticle' ) {
1387 $genre = ( $mtx eq 'dc' ) ? "&rft.type=$genre" : "&rft.genre=$genre";
1389 if ( C4::Context->preference("marcflavour") eq "UNIMARC" ) {
1392 $aulast = $record->subfield( '700', 'a' ) || '';
1393 $aufirst = $record->subfield( '700', 'b' ) || '';
1394 $oauthors = "&rft.au=$aufirst $aulast";
1397 if ( $record->field('200') ) {
1398 for my $au ( $record->field('200')->subfield('g') ) {
1399 $oauthors .= "&rft.au=$au";
1404 ? "&rft.title=" . $record->subfield( '200', 'a' )
1405 : "&rft.title=" . $record->subfield( '200', 'a' ) . "&rft.btitle=" . $record->subfield( '200', 'a' );
1406 $pubyear = $record->subfield( '210', 'd' ) || '';
1407 $publisher = $record->subfield( '210', 'c' ) || '';
1408 $isbn = $record->subfield( '010', 'a' ) || '';
1409 $issn = $record->subfield( '011', 'a' ) || '';
1412 # MARC21 need some improve
1415 if ( $record->field('100') ) {
1416 $oauthors .= "&rft.au=" . $record->subfield( '100', 'a' );
1420 if ( $record->field('700') ) {
1421 for my $au ( $record->field('700')->subfield('a') ) {
1422 $oauthors .= "&rft.au=$au";
1425 $title = "&rft." . $titletype . "title=" . $record->subfield( '245', 'a' );
1426 $subtitle = $record->subfield( '245', 'b' ) || '';
1427 $title .= $subtitle;
1428 if ($titletype eq 'a') {
1429 $pubyear = $record->field('008') || '';
1430 $pubyear = substr($pubyear->data(), 7, 4) if $pubyear;
1431 $isbn = $record->subfield( '773', 'z' ) || '';
1432 $issn = $record->subfield( '773', 'x' ) || '';
1433 if ($mtx eq 'journal') {
1434 $title .= "&rft.title=" . (($record->subfield( '773', 't' ) || $record->subfield( '773', 'a')));
1436 $title .= "&rft.btitle=" . (($record->subfield( '773', 't' ) || $record->subfield( '773', 'a')) || '');
1438 foreach my $rel ($record->subfield( '773', 'g' )) {
1445 $pubyear = $record->subfield( '260', 'c' ) || '';
1446 $publisher = $record->subfield( '260', 'b' ) || '';
1447 $isbn = $record->subfield( '020', 'a' ) || '';
1448 $issn = $record->subfield( '022', 'a' ) || '';
1453 "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";
1454 $coins_value =~ s/(\ |&[^a])/\+/g;
1455 $coins_value =~ s/\"/\"\;/g;
1457 #<!-- 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="
1459 return $coins_value;
1465 return the prices in accordance with the Marc format.
1469 my ( $record, $marcflavour ) = @_;
1473 if ( $marcflavour eq "MARC21" ) {
1474 @listtags = ('345', '020');
1476 } elsif ( $marcflavour eq "UNIMARC" ) {
1477 @listtags = ('345', '010');
1483 for my $field ( $record->field(@listtags) ) {
1484 for my $subfield_value ($field->subfield($subfield)){
1486 $subfield_value = MungeMarcPrice( $subfield_value );
1487 return $subfield_value if ($subfield_value);
1490 return 0; # no price found
1493 =head2 MungeMarcPrice
1495 Return the best guess at what the actual price is from a price field.
1498 sub MungeMarcPrice {
1501 return unless ( $price =~ m/\d/ ); ## No digits means no price.
1503 ## Look for the currency symbol of the active currency, if it's there,
1504 ## start the price string right after the symbol. This allows us to prefer
1505 ## this native currency price over other currency prices, if possible.
1506 my $active_currency = C4::Context->dbh->selectrow_hashref( 'SELECT * FROM currency WHERE active = 1', {} );
1507 my $symbol = quotemeta( $active_currency->{'symbol'} );
1508 if ( $price =~ m/$symbol/ ) {
1509 my @parts = split(/$symbol/, $price );
1513 ## Grab the first number in the string ( can use commas or periods for thousands separator and/or decimal separator )
1514 ( $price ) = $price =~ m/([\d\,\.]+[[\,\.]\d\d]?)/;
1516 ## Split price into array on periods and commas
1517 my @parts = split(/[\,\.]/, $price);
1519 ## If the last grouping of digits is more than 2 characters, assume there is no decimal value and put it back.
1520 my $decimal = pop( @parts );
1521 if ( length( $decimal ) > 2 ) {
1522 push( @parts, $decimal );
1526 $price = join('', @parts );
1529 $price .= ".$decimal";
1536 =head2 GetMarcQuantity
1538 return the quantity of a book. Used in acquisition only, when importing a file an iso2709 from a bookseller
1539 Warning : this is not really in the marc standard. In Unimarc, Electre (the most widely used bookseller) use the 969$a
1543 sub GetMarcQuantity {
1544 my ( $record, $marcflavour ) = @_;
1548 if ( $marcflavour eq "MARC21" ) {
1550 } elsif ( $marcflavour eq "UNIMARC" ) {
1551 @listtags = ('969');
1557 for my $field ( $record->field(@listtags) ) {
1558 for my $subfield_value ($field->subfield($subfield)){
1560 if ($subfield_value) {
1561 # in France, the cents separator is the , but sometimes, ppl use a .
1562 # in this case, the price will be x100 when unformatted ! Replace the . by a , to get a proper price calculation
1563 $subfield_value =~ s/\./,/ if C4::Context->preference("CurrencyFormat") eq "FR";
1564 return $subfield_value;
1568 return 0; # no price found
1572 =head2 GetAuthorisedValueDesc
1574 my $subfieldvalue =get_authorised_value_desc(
1575 $tag, $subf[$i][0],$subf[$i][1], '', $taglib, $category, $opac);
1577 Retrieve the complete description for a given authorised value.
1579 Now takes $category and $value pair too.
1581 my $auth_value_desc =GetAuthorisedValueDesc(
1582 '','', 'DVD' ,'','','CCODE');
1584 If the optional $opac parameter is set to a true value, displays OPAC
1585 descriptions rather than normal ones when they exist.
1589 sub GetAuthorisedValueDesc {
1590 my ( $tag, $subfield, $value, $framework, $tagslib, $category, $opac ) = @_;
1591 my $dbh = C4::Context->dbh;
1595 return $value unless defined $tagslib->{$tag}->{$subfield}->{'authorised_value'};
1598 if ( $tagslib->{$tag}->{$subfield}->{'authorised_value'} eq "branches" ) {
1599 return C4::Branch::GetBranchName($value);
1603 if ( $tagslib->{$tag}->{$subfield}->{'authorised_value'} eq "itemtypes" ) {
1604 return getitemtypeinfo($value)->{description};
1607 #---- "true" authorized value
1608 $category = $tagslib->{$tag}->{$subfield}->{'authorised_value'};
1611 if ( $category ne "" ) {
1612 my $sth = $dbh->prepare( "SELECT lib, lib_opac FROM authorised_values WHERE category = ? AND authorised_value = ?" );
1613 $sth->execute( $category, $value );
1614 my $data = $sth->fetchrow_hashref;
1615 return ( $opac && $data->{'lib_opac'} ) ? $data->{'lib_opac'} : $data->{'lib'};
1617 return $value; # if nothing is found return the original value
1621 =head2 GetMarcControlnumber
1623 $marccontrolnumber = GetMarcControlnumber($record,$marcflavour);
1625 Get the control number / record Identifier from the MARC record and return it.
1629 sub GetMarcControlnumber {
1630 my ( $record, $marcflavour ) = @_;
1631 my $controlnumber = "";
1632 # Control number or Record identifier are the same field in MARC21, UNIMARC and NORMARC
1633 # Keep $marcflavour for possible later use
1634 if ($marcflavour eq "MARC21" || $marcflavour eq "UNIMARC" || $marcflavour eq "NORMARC") {
1635 my $controlnumberField = $record->field('001');
1636 if ($controlnumberField) {
1637 $controlnumber = $controlnumberField->data();
1640 return $controlnumber;
1645 $marcisbnsarray = GetMarcISBN( $record, $marcflavour );
1647 Get all ISBNs from the MARC record and returns them in an array.
1648 ISBNs stored in different fields depending on MARC flavour
1653 my ( $record, $marcflavour ) = @_;
1655 if ( $marcflavour eq "UNIMARC" ) {
1657 } else { # assume marc21 if not unimarc
1664 foreach my $field ( $record->field($scope) ) {
1665 my $value = $field->as_string();
1666 if ( $isbn ne "" ) {
1667 $marcisbn = { marcisbn => $isbn, };
1668 push @marcisbns, $marcisbn;
1671 if ( $isbn ne $value ) {
1672 $isbn = $isbn . " " . $value;
1677 $marcisbn = { marcisbn => $isbn };
1678 push @marcisbns, $marcisbn; #load last tag into array
1686 $marcissnsarray = GetMarcISSN( $record, $marcflavour );
1688 Get all valid ISSNs from the MARC record and returns them in an array.
1689 ISSNs are stored in different fields depending on MARC flavour
1694 my ( $record, $marcflavour ) = @_;
1696 if ( $marcflavour eq "UNIMARC" ) {
1699 else { # assume MARC21 or NORMARC
1703 foreach my $field ( $record->field($scope) ) {
1704 push @marcissns, $field->subfield( 'a' );
1711 $marcnotesarray = GetMarcNotes( $record, $marcflavour );
1713 Get all notes from the MARC record and returns them in an array.
1714 The note are stored in different fields depending on MARC flavour
1719 my ( $record, $marcflavour ) = @_;
1721 if ( $marcflavour eq "UNIMARC" ) {
1723 } else { # assume marc21 if not unimarc
1730 my %blacklist = map { $_ => 1 } split(/,/,C4::Context->preference('NotesBlacklist'));
1731 foreach my $field ( $record->field($scope) ) {
1732 my $tag = $field->tag();
1733 if (!$blacklist{$tag}) {
1734 my $value = $field->as_string();
1735 if ( $note ne "" ) {
1736 $marcnote = { marcnote => $note, };
1737 push @marcnotes, $marcnote;
1740 if ( $note ne $value ) {
1741 $note = $note . " " . $value;
1747 $marcnote = { marcnote => $note };
1748 push @marcnotes, $marcnote; #load last tag into array
1751 } # end GetMarcNotes
1753 =head2 GetMarcSubjects
1755 $marcsubjcts = GetMarcSubjects($record,$marcflavour);
1757 Get all subjects from the MARC record and returns them in an array.
1758 The subjects are stored in different fields depending on MARC flavour
1762 sub GetMarcSubjects {
1763 my ( $record, $marcflavour ) = @_;
1764 my ( $mintag, $maxtag, $fields_filter );
1765 if ( $marcflavour eq "UNIMARC" ) {
1768 $fields_filter = '6..';
1769 } else { # marc21/normarc
1772 $fields_filter = '6..';
1777 my $subject_limit = C4::Context->preference("TraceCompleteSubfields") ? 'su,complete-subfield' : 'su';
1778 my $authoritysep = C4::Context->preference('authoritysep');
1780 foreach my $field ( $record->field($fields_filter) ) {
1781 next unless ($field->tag() >= $mintag && $field->tag() <= $maxtag);
1783 my @subfields = $field->subfields();
1786 # if there is an authority link, build the links with an= subfield9
1787 my $subfield9 = $field->subfield('9');
1790 my $linkvalue = $subfield9;
1791 $linkvalue =~ s/(\(|\))//g;
1792 @link_loop = ( { limit => 'an', 'link' => $linkvalue } );
1793 $authoritylink = $linkvalue
1797 for my $subject_subfield (@subfields) {
1798 next if ( $subject_subfield->[0] eq '9' );
1800 # don't load unimarc subfields 3,4,5
1801 next if ( ( $marcflavour eq "UNIMARC" ) and ( $subject_subfield->[0] =~ /2|3|4|5/ ) );
1802 # don't load MARC21 subfields 2 (FIXME: any more subfields??)
1803 next if ( ( $marcflavour eq "MARC21" ) and ( $subject_subfield->[0] =~ /2/ ) );
1805 my $code = $subject_subfield->[0];
1806 my $value = $subject_subfield->[1];
1807 my $linkvalue = $value;
1808 $linkvalue =~ s/(\(|\))//g;
1809 # if no authority link, build a search query
1810 unless ($subfield9) {
1812 limit => $subject_limit,
1813 'link' => $linkvalue,
1814 operator => (scalar @link_loop) ? ' and ' : undef
1817 my @this_link_loop = @link_loop;
1819 unless ( $code eq '0' ) {
1820 push @subfields_loop, {
1823 link_loop => \@this_link_loop,
1824 separator => (scalar @subfields_loop) ? $authoritysep : ''
1829 push @marcsubjects, {
1830 MARCSUBJECT_SUBFIELDS_LOOP => \@subfields_loop,
1831 authoritylink => $authoritylink,
1835 return \@marcsubjects;
1836 } #end getMARCsubjects
1838 =head2 GetMarcAuthors
1840 authors = GetMarcAuthors($record,$marcflavour);
1842 Get all authors from the MARC record and returns them in an array.
1843 The authors are stored in different fields depending on MARC flavour
1847 sub GetMarcAuthors {
1848 my ( $record, $marcflavour ) = @_;
1849 my ( $mintag, $maxtag, $fields_filter );
1851 # tagslib useful for UNIMARC author reponsabilities
1853 &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.
1854 if ( $marcflavour eq "UNIMARC" ) {
1857 $fields_filter = '7..';
1858 } else { # marc21/normarc
1861 $fields_filter = '7..';
1865 my $authoritysep = C4::Context->preference('authoritysep');
1867 foreach my $field ( $record->field($fields_filter) ) {
1868 next unless $field->tag() >= $mintag && $field->tag() <= $maxtag;
1871 my @subfields = $field->subfields();
1874 # if there is an authority link, build the link with Koha-Auth-Number: subfield9
1875 my $subfield9 = $field->subfield('9');
1877 my $linkvalue = $subfield9;
1878 $linkvalue =~ s/(\(|\))//g;
1879 @link_loop = ( { 'limit' => 'an', 'link' => $linkvalue } );
1883 for my $authors_subfield (@subfields) {
1884 next if ( $authors_subfield->[0] eq '9' );
1886 # don't load unimarc subfields 3, 5
1887 next if ( $marcflavour eq 'UNIMARC' and ( $authors_subfield->[0] =~ /3|5/ ) );
1889 my $code = $authors_subfield->[0];
1890 my $value = $authors_subfield->[1];
1891 my $linkvalue = $value;
1892 $linkvalue =~ s/(\(|\))//g;
1893 # UNIMARC author responsibility
1894 if ( $marcflavour eq 'UNIMARC' and $code eq '4' ) {
1895 $value = GetAuthorisedValueDesc( $field->tag(), $code, $value, '', $tagslib );
1896 $linkvalue = "($value)";
1898 # if no authority link, build a search query
1899 unless ($subfield9) {
1902 'link' => $linkvalue,
1903 operator => (scalar @link_loop) ? ' and ' : undef
1906 my @this_link_loop = @link_loop;
1908 unless ( $code eq '0') {
1909 push @subfields_loop, {
1910 tag => $field->tag(),
1913 link_loop => \@this_link_loop,
1914 separator => (scalar @subfields_loop) ? $authoritysep : ''
1918 push @marcauthors, {
1919 MARCAUTHOR_SUBFIELDS_LOOP => \@subfields_loop,
1920 authoritylink => $subfield9,
1923 return \@marcauthors;
1928 $marcurls = GetMarcUrls($record,$marcflavour);
1930 Returns arrayref of URLs from MARC data, suitable to pass to tmpl loop.
1931 Assumes web resources (not uncommon in MARC21 to omit resource type ind)
1936 my ( $record, $marcflavour ) = @_;
1939 for my $field ( $record->field('856') ) {
1941 for my $note ( $field->subfield('z') ) {
1942 push @notes, { note => $note };
1944 my @urls = $field->subfield('u');
1945 foreach my $url (@urls) {
1947 if ( $marcflavour eq 'MARC21' ) {
1948 my $s3 = $field->subfield('3');
1949 my $link = $field->subfield('y');
1950 unless ( $url =~ /^\w+:/ ) {
1951 if ( $field->indicator(1) eq '7' ) {
1952 $url = $field->subfield('2') . "://" . $url;
1953 } elsif ( $field->indicator(1) eq '1' ) {
1954 $url = 'ftp://' . $url;
1957 # properly, this should be if ind1=4,
1958 # however we will assume http protocol since we're building a link.
1959 $url = 'http://' . $url;
1963 # TODO handle ind 2 (relationship)
1968 $marcurl->{'linktext'} = $link || $s3 || C4::Context->preference('URLLinkText') || $url;
1969 $marcurl->{'part'} = $s3 if ($link);
1970 $marcurl->{'toc'} = 1 if ( defined($s3) && $s3 =~ /^[Tt]able/ );
1972 $marcurl->{'linktext'} = $field->subfield('2') || C4::Context->preference('URLLinkText') || $url;
1973 $marcurl->{'MARCURL'} = $url;
1975 push @marcurls, $marcurl;
1981 =head2 GetMarcSeries
1983 $marcseriesarray = GetMarcSeries($record,$marcflavour);
1985 Get all series from the MARC record and returns them in an array.
1986 The series are stored in different fields depending on MARC flavour
1991 my ( $record, $marcflavour ) = @_;
1992 my ( $mintag, $maxtag, $fields_filter );
1993 if ( $marcflavour eq "UNIMARC" ) {
1996 $fields_filter = '6..';
1997 } else { # marc21/normarc
2000 $fields_filter = '4..';
2004 my $authoritysep = C4::Context->preference('authoritysep');
2006 foreach my $field ( $record->field($fields_filter) ) {
2007 next unless $field->tag() >= $mintag && $field->tag() <= $maxtag;
2009 my @subfields = $field->subfields();
2012 for my $series_subfield (@subfields) {
2014 # ignore $9, used for authority link
2015 next if ( $series_subfield->[0] eq '9' );
2018 my $code = $series_subfield->[0];
2019 my $value = $series_subfield->[1];
2020 my $linkvalue = $value;
2021 $linkvalue =~ s/(\(|\))//g;
2023 # see if this is an instance of a volume
2024 if ( $code eq 'v' ) {
2029 'link' => $linkvalue,
2030 operator => (scalar @link_loop) ? ' and ' : undef
2033 if ($volume_number) {
2034 push @subfields_loop, { volumenum => $value };
2036 push @subfields_loop, {
2039 link_loop => \@link_loop,
2040 separator => (scalar @subfields_loop) ? $authoritysep : '',
2041 volumenum => $volume_number,
2045 push @marcseries, { MARCSERIES_SUBFIELDS_LOOP => \@subfields_loop };
2048 return \@marcseries;
2049 } #end getMARCseriess
2053 $marchostsarray = GetMarcHosts($record,$marcflavour);
2055 Get all host records (773s MARC21, 461 UNIMARC) from the MARC record and returns them in an array.
2060 my ( $record, $marcflavour ) = @_;
2061 my ( $tag,$title_subf,$bibnumber_subf,$itemnumber_subf);
2062 $marcflavour ||="MARC21";
2063 if ( $marcflavour eq "MARC21" || $marcflavour eq "NORMARC" ) {
2066 $bibnumber_subf ="0";
2067 $itemnumber_subf='9';
2069 elsif ($marcflavour eq "UNIMARC") {
2072 $bibnumber_subf ="0";
2073 $itemnumber_subf='9';
2078 foreach my $field ( $record->field($tag)) {
2082 my $hostbiblionumber = $field->subfield("$bibnumber_subf");
2083 my $hosttitle = $field->subfield($title_subf);
2084 my $hostitemnumber=$field->subfield($itemnumber_subf);
2085 push @fields_loop, { hostbiblionumber => $hostbiblionumber, hosttitle => $hosttitle, hostitemnumber => $hostitemnumber};
2086 push @marchosts, { MARCHOSTS_FIELDS_LOOP => \@fields_loop };
2089 my $marchostsarray = \@marchosts;
2090 return $marchostsarray;
2093 =head2 GetFrameworkCode
2095 $frameworkcode = GetFrameworkCode( $biblionumber )
2099 sub GetFrameworkCode {
2100 my ($biblionumber) = @_;
2101 my $dbh = C4::Context->dbh;
2102 my $sth = $dbh->prepare("SELECT frameworkcode FROM biblio WHERE biblionumber=?");
2103 $sth->execute($biblionumber);
2104 my ($frameworkcode) = $sth->fetchrow;
2105 return $frameworkcode;
2108 =head2 TransformKohaToMarc
2110 $record = TransformKohaToMarc( $hash )
2112 This function builds partial MARC::Record from a hash
2113 Hash entries can be from biblio or biblioitems.
2115 This function is called in acquisition module, to create a basic catalogue
2116 entry from user entry
2121 sub TransformKohaToMarc {
2123 my $record = MARC::Record->new();
2124 SetMarcUnicodeFlag( $record, C4::Context->preference("marcflavour") );
2125 my $db_to_marc = C4::Context->marcfromkohafield;
2126 while ( my ($name, $value) = each %$hash ) {
2127 next unless my $dtm = $db_to_marc->{''}->{$name};
2128 next unless ( scalar( @$dtm ) );
2129 my ($tag, $letter) = @$dtm;
2130 foreach my $value ( split(/\s?\|\s?/, $value, -1) ) {
2131 if ( my $field = $record->field($tag) ) {
2132 $field->add_subfields( $letter => $value );
2135 $record->insert_fields_ordered( MARC::Field->new(
2136 $tag, " ", " ", $letter => $value ) );
2144 =head2 PrepHostMarcField
2146 $hostfield = PrepHostMarcField ( $hostbiblionumber,$hostitemnumber,$marcflavour )
2148 This function returns a host field populated with data from the host record, the field can then be added to an analytical record
2152 sub PrepHostMarcField {
2153 my ($hostbiblionumber,$hostitemnumber, $marcflavour) = @_;
2154 $marcflavour ||="MARC21";
2157 my $hostrecord = GetMarcBiblio($hostbiblionumber);
2158 my $item = C4::Items::GetItem($hostitemnumber);
2161 if ( $marcflavour eq "MARC21" || $marcflavour eq "NORMARC" ) {
2165 if ($hostrecord->subfield('100','a')){
2166 $mainentry = $hostrecord->subfield('100','a');
2167 } elsif ($hostrecord->subfield('110','a')){
2168 $mainentry = $hostrecord->subfield('110','a');
2170 $mainentry = $hostrecord->subfield('111','a');
2173 # qualification info
2175 if (my $field260 = $hostrecord->field('260')){
2176 $qualinfo = $field260->as_string( 'abc' );
2181 my $ed = $hostrecord->subfield('250','a');
2182 my $barcode = $item->{'barcode'};
2183 my $title = $hostrecord->subfield('245','a');
2185 # record control number, 001 with 003 and prefix
2187 if ($hostrecord->field('001')){
2188 $recctrlno = $hostrecord->field('001')->data();
2189 if ($hostrecord->field('003')){
2190 $recctrlno = '('.$hostrecord->field('003')->data().')'.$recctrlno;
2195 my $issn = $hostrecord->subfield('022','a');
2196 my $isbn = $hostrecord->subfield('020','a');
2199 $hostmarcfield = MARC::Field->new(
2201 '0' => $hostbiblionumber,
2202 '9' => $hostitemnumber,
2212 } elsif ($marcflavour eq "UNIMARC") {
2213 $hostmarcfield = MARC::Field->new(
2215 '0' => $hostbiblionumber,
2216 't' => $hostrecord->subfield('200','a'),
2217 '9' => $hostitemnumber
2221 return $hostmarcfield;
2224 =head2 TransformHtmlToXml
2226 $xml = TransformHtmlToXml( $tags, $subfields, $values, $indicator,
2227 $ind_tag, $auth_type )
2229 $auth_type contains :
2233 =item - nothing : rebuild a biblio. In UNIMARC the encoding is in 100$a pos 26/27
2235 =item - UNIMARCAUTH : rebuild an authority. In UNIMARC, the encoding is in 100$a pos 13/14
2237 =item - ITEM : rebuild an item : in UNIMARC, 100$a, it's in the biblio ! (otherwise, we would get 2 100 fields !)
2243 sub TransformHtmlToXml {
2244 my ( $tags, $subfields, $values, $indicator, $ind_tag, $auth_type ) = @_;
2245 my $xml = MARC::File::XML::header('UTF-8');
2246 $xml .= "<record>\n";
2247 $auth_type = C4::Context->preference('marcflavour') unless $auth_type;
2248 MARC::File::XML->default_record_format($auth_type);
2250 # in UNIMARC, field 100 contains the encoding
2251 # check that there is one, otherwise the
2252 # MARC::Record->new_from_xml will fail (and Koha will die)
2253 my $unimarc_and_100_exist = 0;
2254 $unimarc_and_100_exist = 1 if $auth_type eq 'ITEM'; # if we rebuild an item, no need of a 100 field
2259 for ( my $i = 0 ; $i < @$tags ; $i++ ) {
2261 if ( C4::Context->preference('marcflavour') eq 'UNIMARC' and @$tags[$i] eq "100" and @$subfields[$i] eq "a" ) {
2263 # if we have a 100 field and it's values are not correct, skip them.
2264 # if we don't have any valid 100 field, we will create a default one at the end
2265 my $enc = substr( @$values[$i], 26, 2 );
2266 if ( $enc eq '01' or $enc eq '50' or $enc eq '03' ) {
2267 $unimarc_and_100_exist = 1;
2272 @$values[$i] =~ s/&/&/g;
2273 @$values[$i] =~ s/</</g;
2274 @$values[$i] =~ s/>/>/g;
2275 @$values[$i] =~ s/"/"/g;
2276 @$values[$i] =~ s/'/'/g;
2278 # if ( !utf8::is_utf8( @$values[$i] ) ) {
2279 # utf8::decode( @$values[$i] );
2281 if ( ( @$tags[$i] ne $prevtag ) ) {
2282 $j++ unless ( @$tags[$i] eq "" );
2283 my $indicator1 = eval { substr( @$indicator[$j], 0, 1 ) };
2284 my $indicator2 = eval { substr( @$indicator[$j], 1, 1 ) };
2285 my $ind1 = _default_ind_to_space($indicator1);
2287 if ( @$indicator[$j] ) {
2288 $ind2 = _default_ind_to_space($indicator2);
2290 warn "Indicator in @$tags[$i] is empty";
2294 $xml .= "</datafield>\n";
2295 if ( ( @$tags[$i] && @$tags[$i] > 10 )
2296 && ( @$values[$i] ne "" ) ) {
2297 $xml .= "<datafield tag=\"@$tags[$i]\" ind1=\"$ind1\" ind2=\"$ind2\">\n";
2298 $xml .= "<subfield code=\"@$subfields[$i]\">@$values[$i]</subfield>\n";
2304 if ( @$values[$i] ne "" ) {
2307 if ( @$tags[$i] eq "000" ) {
2308 $xml .= "<leader>@$values[$i]</leader>\n";
2311 # rest of the fixed fields
2312 } elsif ( @$tags[$i] < 10 ) {
2313 $xml .= "<controlfield tag=\"@$tags[$i]\">@$values[$i]</controlfield>\n";
2316 $xml .= "<datafield tag=\"@$tags[$i]\" ind1=\"$ind1\" ind2=\"$ind2\">\n";
2317 $xml .= "<subfield code=\"@$subfields[$i]\">@$values[$i]</subfield>\n";
2322 } else { # @$tags[$i] eq $prevtag
2323 my $indicator1 = eval { substr( @$indicator[$j], 0, 1 ) };
2324 my $indicator2 = eval { substr( @$indicator[$j], 1, 1 ) };
2325 my $ind1 = _default_ind_to_space($indicator1);
2327 if ( @$indicator[$j] ) {
2328 $ind2 = _default_ind_to_space($indicator2);
2330 warn "Indicator in @$tags[$i] is empty";
2333 if ( @$values[$i] eq "" ) {
2336 $xml .= "<datafield tag=\"@$tags[$i]\" ind1=\"$ind1\" ind2=\"$ind2\">\n";
2339 $xml .= "<subfield code=\"@$subfields[$i]\">@$values[$i]</subfield>\n";
2342 $prevtag = @$tags[$i];
2344 $xml .= "</datafield>\n" if $xml =~ m/<datafield/;
2345 if ( C4::Context->preference('marcflavour') eq 'UNIMARC' and !$unimarc_and_100_exist ) {
2347 # warn "SETTING 100 for $auth_type";
2348 my $string = strftime( "%Y%m%d", localtime(time) );
2350 # set 50 to position 26 is biblios, 13 if authorities
2352 $pos = 13 if $auth_type eq 'UNIMARCAUTH';
2353 $string = sprintf( "%-*s", 35, $string );
2354 substr( $string, $pos, 6, "50" );
2355 $xml .= "<datafield tag=\"100\" ind1=\"\" ind2=\"\">\n";
2356 $xml .= "<subfield code=\"a\">$string</subfield>\n";
2357 $xml .= "</datafield>\n";
2359 $xml .= "</record>\n";
2360 $xml .= MARC::File::XML::footer();
2364 =head2 _default_ind_to_space
2366 Passed what should be an indicator returns a space
2367 if its undefined or zero length
2371 sub _default_ind_to_space {
2373 if ( !defined $s || $s eq q{} ) {
2379 =head2 TransformHtmlToMarc
2381 L<$record> = TransformHtmlToMarc(L<$cgi>)
2382 L<$cgi> is the CGI object which containts the values for subfields
2384 'tag_010_indicator1_531951' ,
2385 'tag_010_indicator2_531951' ,
2386 'tag_010_code_a_531951_145735' ,
2387 'tag_010_subfield_a_531951_145735' ,
2388 'tag_200_indicator1_873510' ,
2389 'tag_200_indicator2_873510' ,
2390 'tag_200_code_a_873510_673465' ,
2391 'tag_200_subfield_a_873510_673465' ,
2392 'tag_200_code_b_873510_704318' ,
2393 'tag_200_subfield_b_873510_704318' ,
2394 'tag_200_code_e_873510_280822' ,
2395 'tag_200_subfield_e_873510_280822' ,
2396 'tag_200_code_f_873510_110730' ,
2397 'tag_200_subfield_f_873510_110730' ,
2399 L<$record> is the MARC::Record object.
2403 sub TransformHtmlToMarc {
2406 my @params = $cgi->param();
2408 # explicitly turn on the UTF-8 flag for all
2409 # 'tag_' parameters to avoid incorrect character
2410 # conversion later on
2411 my $cgi_params = $cgi->Vars;
2412 foreach my $param_name ( keys %$cgi_params ) {
2413 if ( $param_name =~ /^tag_/ ) {
2414 my $param_value = $cgi_params->{$param_name};
2415 if ( utf8::decode($param_value) ) {
2416 $cgi_params->{$param_name} = $param_value;
2419 # FIXME - need to do something if string is not valid UTF-8
2423 # creating a new record
2424 my $record = MARC::Record->new();
2427 #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!
2428 while ( $params[$i] ) { # browse all CGI params
2429 my $param = $params[$i];
2432 # if we are on biblionumber, store it in the MARC::Record (it may not be in the edited fields)
2433 if ( $param eq 'biblionumber' ) {
2434 my ( $biblionumbertagfield, $biblionumbertagsubfield ) = &GetMarcFromKohaField( "biblio.biblionumber", '' );
2435 if ( $biblionumbertagfield < 10 ) {
2436 $newfield = MARC::Field->new( $biblionumbertagfield, $cgi->param($param), );
2438 $newfield = MARC::Field->new( $biblionumbertagfield, '', '', "$biblionumbertagsubfield" => $cgi->param($param), );
2440 push @fields, $newfield if ($newfield);
2441 } elsif ( $param =~ /^tag_(\d*)_indicator1_/ ) { # new field start when having 'input name="..._indicator1_..."
2444 my $ind1 = _default_ind_to_space( substr( $cgi->param($param), 0, 1 ) );
2445 my $ind2 = _default_ind_to_space( substr( $cgi->param( $params[ $i + 1 ] ), 0, 1 ) );
2449 if ( $tag < 10 ) { # no code for theses fields
2450 # in MARC editor, 000 contains the leader.
2451 if ( $tag eq '000' ) {
2452 # Force a fake leader even if not provided to avoid crashing
2453 # during decoding MARC record containing UTF-8 characters
2455 length( $cgi->param($params[$j+1]) ) == 24
2456 ? $cgi->param( $params[ $j + 1 ] )
2460 # between 001 and 009 (included)
2461 } elsif ( $cgi->param( $params[ $j + 1 ] ) ne '' ) {
2462 $newfield = MARC::Field->new( $tag, $cgi->param( $params[ $j + 1 ] ), );
2465 # > 009, deal with subfields
2467 # browse subfields for this tag (reason for _code_ match)
2468 while(defined $params[$j] && $params[$j] =~ /_code_/) {
2469 last unless defined $params[$j+1];
2470 #if next param ne subfield, then it was probably empty
2471 #try next param by incrementing j
2472 if($params[$j+1]!~/_subfield_/) {$j++; next; }
2473 my $fval= $cgi->param($params[$j+1]);
2474 #check if subfield value not empty and field exists
2475 if($fval ne '' && $newfield) {
2476 $newfield->add_subfields( $cgi->param($params[$j]) => $fval);
2478 elsif($fval ne '') {
2479 $newfield = MARC::Field->new( $tag, $ind1, $ind2, $cgi->param($params[$j]) => $fval );
2483 $i= $j-1; #update i for outer loop accordingly
2485 push @fields, $newfield if ($newfield);
2490 $record->append_fields(@fields);
2494 # cache inverted MARC field map
2495 our $inverted_field_map;
2497 =head2 TransformMarcToKoha
2499 $result = TransformMarcToKoha( $dbh, $record, $frameworkcode )
2501 Extract data from a MARC bib record into a hashref representing
2502 Koha biblio, biblioitems, and items fields.
2506 sub TransformMarcToKoha {
2507 my ( $dbh, $record, $frameworkcode, $limit_table ) = @_;
2510 $limit_table = $limit_table || 0;
2511 $frameworkcode = '' unless defined $frameworkcode;
2513 unless ( defined $inverted_field_map ) {
2514 $inverted_field_map = _get_inverted_marc_field_map();
2518 if ( defined $limit_table && $limit_table eq 'items' ) {
2519 $tables{'items'} = 1;
2521 $tables{'items'} = 1;
2522 $tables{'biblio'} = 1;
2523 $tables{'biblioitems'} = 1;
2526 # traverse through record
2527 MARCFIELD: foreach my $field ( $record->fields() ) {
2528 my $tag = $field->tag();
2529 next MARCFIELD unless exists $inverted_field_map->{$frameworkcode}->{$tag};
2530 if ( $field->is_control_field() ) {
2531 my $kohafields = $inverted_field_map->{$frameworkcode}->{$tag}->{list};
2532 ENTRY: foreach my $entry ( @{$kohafields} ) {
2533 my ( $subfield, $table, $column ) = @{$entry};
2534 next ENTRY unless exists $tables{$table};
2535 my $key = _disambiguate( $table, $column );
2536 if ( $result->{$key} ) {
2537 unless ( ( $key eq "biblionumber" or $key eq "biblioitemnumber" ) and ( $field->data() eq "" ) ) {
2538 $result->{$key} .= " | " . $field->data();
2541 $result->{$key} = $field->data();
2546 # deal with subfields
2547 MARCSUBFIELD: foreach my $sf ( $field->subfields() ) {
2548 my $code = $sf->[0];
2549 next MARCSUBFIELD unless exists $inverted_field_map->{$frameworkcode}->{$tag}->{sfs}->{$code};
2550 my $value = $sf->[1];
2551 SFENTRY: foreach my $entry ( @{ $inverted_field_map->{$frameworkcode}->{$tag}->{sfs}->{$code} } ) {
2552 my ( $table, $column ) = @{$entry};
2553 next SFENTRY unless exists $tables{$table};
2554 my $key = _disambiguate( $table, $column );
2555 if ( $result->{$key} ) {
2556 unless ( ( $key eq "biblionumber" or $key eq "biblioitemnumber" ) and ( $value eq "" ) ) {
2557 $result->{$key} .= " | " . $value;
2560 $result->{$key} = $value;
2567 # modify copyrightdate to keep only the 1st year found
2568 if ( exists $result->{'copyrightdate'} ) {
2569 my $temp = $result->{'copyrightdate'};
2570 $temp =~ m/c(\d\d\d\d)/;
2571 if ( $temp =~ m/c(\d\d\d\d)/ and $1 > 0 ) { # search cYYYY first
2572 $result->{'copyrightdate'} = $1;
2573 } else { # if no cYYYY, get the 1st date.
2574 $temp =~ m/(\d\d\d\d)/;
2575 $result->{'copyrightdate'} = $1;
2579 # modify publicationyear to keep only the 1st year found
2580 if ( exists $result->{'publicationyear'} ) {
2581 my $temp = $result->{'publicationyear'};
2582 if ( $temp =~ m/c(\d\d\d\d)/ and $1 > 0 ) { # search cYYYY first
2583 $result->{'publicationyear'} = $1;
2584 } else { # if no cYYYY, get the 1st date.
2585 $temp =~ m/(\d\d\d\d)/;
2586 $result->{'publicationyear'} = $1;
2593 sub _get_inverted_marc_field_map {
2595 my $relations = C4::Context->marcfromkohafield;
2597 foreach my $frameworkcode ( keys %{$relations} ) {
2598 foreach my $kohafield ( keys %{ $relations->{$frameworkcode} } ) {
2599 next unless @{ $relations->{$frameworkcode}->{$kohafield} }; # not all columns are mapped to MARC tag & subfield
2600 my $tag = $relations->{$frameworkcode}->{$kohafield}->[0];
2601 my $subfield = $relations->{$frameworkcode}->{$kohafield}->[1];
2602 my ( $table, $column ) = split /[.]/, $kohafield, 2;
2603 push @{ $field_map->{$frameworkcode}->{$tag}->{list} }, [ $subfield, $table, $column ];
2604 push @{ $field_map->{$frameworkcode}->{$tag}->{sfs}->{$subfield} }, [ $table, $column ];
2610 =head2 _disambiguate
2612 $newkey = _disambiguate($table, $field);
2614 This is a temporary hack to distinguish between the
2615 following sets of columns when using TransformMarcToKoha.
2617 items.cn_source & biblioitems.cn_source
2618 items.cn_sort & biblioitems.cn_sort
2620 Columns that are currently NOT distinguished (FIXME
2621 due to lack of time to fully test) are:
2623 biblio.notes and biblioitems.notes
2628 FIXME - this is necessary because prefixing each column
2629 name with the table name would require changing lots
2630 of code and templates, and exposing more of the DB
2631 structure than is good to the UI templates, particularly
2632 since biblio and bibloitems may well merge in a future
2633 version. In the future, it would also be good to
2634 separate DB access and UI presentation field names
2639 sub CountItemsIssued {
2640 my ($biblionumber) = @_;
2641 my $dbh = C4::Context->dbh;
2642 my $sth = $dbh->prepare('SELECT COUNT(*) as issuedCount FROM items, issues WHERE items.itemnumber = issues.itemnumber AND items.biblionumber = ?');
2643 $sth->execute($biblionumber);
2644 my $row = $sth->fetchrow_hashref();
2645 return $row->{'issuedCount'};
2649 my ( $table, $column ) = @_;
2650 if ( $column eq "cn_sort" or $column eq "cn_source" ) {
2651 return $table . '.' . $column;
2658 =head2 get_koha_field_from_marc
2660 $result->{_disambiguate($table, $field)} =
2661 get_koha_field_from_marc($table,$field,$record,$frameworkcode);
2663 Internal function to map data from the MARC record to a specific non-MARC field.
2664 FIXME: this is meant to replace TransformMarcToKohaOneField after more testing.
2668 sub get_koha_field_from_marc {
2669 my ( $koha_table, $koha_column, $record, $frameworkcode ) = @_;
2670 my ( $tagfield, $subfield ) = GetMarcFromKohaField( $koha_table . '.' . $koha_column, $frameworkcode );
2672 foreach my $field ( $record->field($tagfield) ) {
2673 if ( $field->tag() < 10 ) {
2675 $kohafield .= " | " . $field->data();
2677 $kohafield = $field->data();
2680 if ( $field->subfields ) {
2681 my @subfields = $field->subfields();
2682 foreach my $subfieldcount ( 0 .. $#subfields ) {
2683 if ( $subfields[$subfieldcount][0] eq $subfield ) {
2685 $kohafield .= " | " . $subfields[$subfieldcount][1];
2687 $kohafield = $subfields[$subfieldcount][1];
2697 =head2 TransformMarcToKohaOneField
2699 $result = TransformMarcToKohaOneField( $kohatable, $kohafield, $record, $result, $frameworkcode )
2703 sub TransformMarcToKohaOneField {
2705 # FIXME ? if a field has a repeatable subfield that is used in old-db,
2706 # only the 1st will be retrieved...
2707 my ( $kohatable, $kohafield, $record, $result, $frameworkcode ) = @_;
2709 my ( $tagfield, $subfield ) = GetMarcFromKohaField( $kohatable . "." . $kohafield, $frameworkcode );
2710 foreach my $field ( $record->field($tagfield) ) {
2711 if ( $field->tag() < 10 ) {
2712 if ( $result->{$kohafield} ) {
2713 $result->{$kohafield} .= " | " . $field->data();
2715 $result->{$kohafield} = $field->data();
2718 if ( $field->subfields ) {
2719 my @subfields = $field->subfields();
2720 foreach my $subfieldcount ( 0 .. $#subfields ) {
2721 if ( $subfields[$subfieldcount][0] eq $subfield ) {
2722 if ( $result->{$kohafield} ) {
2723 $result->{$kohafield} .= " | " . $subfields[$subfieldcount][1];
2725 $result->{$kohafield} = $subfields[$subfieldcount][1];
2739 # true ModZebra commented until indexdata fixes zebraDB crashes (it seems they occur on multiple updates
2741 # replaced by a zebraqueue table, that is filled with ModZebra to run.
2742 # the table is emptied by misc/cronjobs/zebraqueue_start.pl script
2743 # =head2 ModZebrafiles
2745 # &ModZebrafiles( $dbh, $biblionumber, $record, $folder, $server );
2749 # sub ModZebrafiles {
2751 # my ( $dbh, $biblionumber, $record, $folder, $server ) = @_;
2755 # C4::Context->zebraconfig($server)->{directory} . "/" . $folder . "/";
2756 # unless ( opendir( DIR, "$zebradir" ) ) {
2757 # warn "$zebradir not found";
2761 # my $filename = $zebradir . $biblionumber;
2764 # open( OUTPUT, ">", $filename . ".xml" );
2765 # print OUTPUT $record;
2772 ModZebra( $biblionumber, $op, $server, $oldRecord, $newRecord );
2774 $biblionumber is the biblionumber we want to index
2776 $op is specialUpdate or delete, and is used to know what we want to do
2778 $server is the server that we want to update
2780 $oldRecord is the MARC::Record containing the previous version of the record. This is used only when
2781 NoZebra=1, as NoZebra indexing needs to know the previous version of a record in order to
2784 $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.
2789 ###Accepts a $server variable thus we can use it for biblios authorities or other zebra dbs
2790 my ( $biblionumber, $op, $server, $oldRecord, $newRecord ) = @_;
2791 my $dbh = C4::Context->dbh;
2793 # true ModZebra commented until indexdata fixes zebraDB crashes (it seems they occur on multiple updates
2795 # replaced by a zebraqueue table, that is filled with ModZebra to run.
2796 # the table is emptied by misc/cronjobs/zebraqueue_start.pl script
2798 if ( C4::Context->preference("NoZebra") ) {
2800 # lock the nozebra table : we will read index lines, update them in Perl process
2801 # and write everything in 1 transaction.
2802 # lock the table to avoid someone else overwriting what we are doing
2803 $dbh->do('LOCK TABLES nozebra WRITE,biblio WRITE,biblioitems WRITE, systempreferences WRITE, auth_types WRITE, auth_header WRITE, auth_subfield_structure READ');
2804 my %result; # the result hash that will be built by deletion / add, and written on mySQL at the end, to improve speed
2805 if ( $op eq 'specialUpdate' ) {
2807 # OK, we have to add or update the record
2808 # 1st delete (virtually, in indexes), if record actually exists
2810 %result = _DelBiblioNoZebra( $biblionumber, $oldRecord, $server );
2813 # ... add the record
2814 %result = _AddBiblioNoZebra( $biblionumber, $newRecord, $server, %result );
2817 # it's a deletion, delete the record...
2818 # warn "DELETE the record $biblionumber on $server".$record->as_formatted;
2819 %result = _DelBiblioNoZebra( $biblionumber, $oldRecord, $server );
2822 # ok, now update the database...
2823 my $sth = $dbh->prepare("UPDATE nozebra SET biblionumbers=? WHERE server=? AND indexname=? AND value=?");
2824 foreach my $key ( keys %result ) {
2825 foreach my $index ( keys %{ $result{$key} } ) {
2826 $sth->execute( $result{$key}->{$index}, $server, $key, $index );
2829 $dbh->do('UNLOCK TABLES');
2833 # we use zebra, just fill zebraqueue table
2835 my $check_sql = "SELECT COUNT(*) FROM zebraqueue
2837 AND biblio_auth_number = ?
2840 my $check_sth = $dbh->prepare_cached($check_sql);
2841 $check_sth->execute( $server, $biblionumber, $op );
2842 my ($count) = $check_sth->fetchrow_array;
2843 $check_sth->finish();
2844 if ( $count == 0 ) {
2845 my $sth = $dbh->prepare("INSERT INTO zebraqueue (biblio_auth_number,server,operation) VALUES(?,?,?)");
2846 $sth->execute( $biblionumber, $server, $op );
2852 =head2 GetNoZebraIndexes
2854 %indexes = GetNoZebraIndexes;
2856 return the data from NoZebraIndexes syspref.
2860 sub GetNoZebraIndexes {
2861 my $no_zebra_indexes = C4::Context->preference('NoZebraIndexes');
2863 INDEX: foreach my $line ( split /['"],[\n\r]*/, $no_zebra_indexes ) {
2864 $line =~ /(.*)=>(.*)/;
2865 my $index = $1; # initial ' or " is removed afterwards
2867 $index =~ s/'|"|\s//g;
2868 $fields =~ s/'|"|\s//g;
2869 $indexes{$index} = $fields;
2874 =head2 EmbedItemsInMarcBiblio
2876 EmbedItemsInMarcBiblio($marc, $biblionumber, $itemnumbers);
2878 Given a MARC::Record object containing a bib record,
2879 modify it to include the items attached to it as 9XX
2880 per the bib's MARC framework.
2881 if $itemnumbers is defined, only specified itemnumbers are embedded
2885 sub EmbedItemsInMarcBiblio {
2886 my ($marc, $biblionumber, $itemnumbers) = @_;
2887 croak "No MARC record" unless $marc;
2889 $itemnumbers = [] unless defined $itemnumbers;
2891 my $frameworkcode = GetFrameworkCode($biblionumber);
2892 _strip_item_fields($marc, $frameworkcode);
2894 # ... and embed the current items
2895 my $dbh = C4::Context->dbh;
2896 my $sth = $dbh->prepare("SELECT itemnumber FROM items WHERE biblionumber = ?");
2897 $sth->execute($biblionumber);
2899 my ( $itemtag, $itemsubfield ) = GetMarcFromKohaField( "items.itemnumber", $frameworkcode );
2900 while (my ($itemnumber) = $sth->fetchrow_array) {
2901 next if @$itemnumbers and not grep { $_ == $itemnumber } @$itemnumbers;
2903 my $item_marc = C4::Items::GetMarcItem($biblionumber, $itemnumber);
2904 push @item_fields, $item_marc->field($itemtag);
2906 $marc->append_fields(@item_fields);
2909 =head1 INTERNAL FUNCTIONS
2911 =head2 _DelBiblioNoZebra($biblionumber,$record,$server);
2913 function to delete a biblio in NoZebra indexes
2914 This function does NOT delete anything in database : it reads all the indexes entries
2915 that have to be deleted & delete them in the hash
2917 The SQL part is done either :
2918 - after the Add if we are modifying a biblio (delete + add again)
2919 - immediatly after this sub if we are doing a true deletion.
2921 $server can be 'biblioserver' or 'authorityserver' : it indexes biblios or authorities (in the same table, $server being part of the table itself
2925 sub _DelBiblioNoZebra {
2926 my ( $biblionumber, $record, $server ) = @_;
2929 my $dbh = C4::Context->dbh;
2934 if ( $server eq 'biblioserver' ) {
2935 %index = GetNoZebraIndexes;
2937 # get title of the record (to store the 10 first letters with the index)
2938 my ( $titletag, $titlesubfield ) = GetMarcFromKohaField( 'biblio.title', '' ); # FIXME: should be GetFrameworkCode($biblionumber) ??
2939 $title = lc( $record->subfield( $titletag, $titlesubfield ) );
2942 # for authorities, the "title" is the $a mainentry
2943 my ( $auth_type_tag, $auth_type_sf ) = C4::AuthoritiesMarc::get_auth_type_location();
2944 my $authref = C4::AuthoritiesMarc::GetAuthType( $record->subfield( $auth_type_tag, $auth_type_sf ) );
2945 warn "ERROR : authtype undefined for " . $record->as_formatted unless $authref;
2946 $title = $record->subfield( $authref->{auth_tag_to_report}, 'a' );
2947 $index{'mainmainentry'} = $authref->{'auth_tag_to_report'} . 'a';
2948 $index{'mainentry'} = $authref->{'auth_tag_to_report'} . '*';
2949 $index{'auth_type'} = "${auth_type_tag}${auth_type_sf}";
2954 # remove blancks comma (that could cause problem when decoding the string for CQL retrieval) and regexp specific values
2955 $title =~ s/ |,|;|\[|\]|\(|\)|\*|-|'|=//g;
2957 # limit to 10 char, should be enough, and limit the DB size
2958 $title = substr( $title, 0, 10 );
2961 my $sth2 = $dbh->prepare('SELECT biblionumbers FROM nozebra WHERE server=? AND indexname=? AND value=?');
2962 foreach my $field ( $record->fields() ) {
2964 #parse each subfield
2965 next if $field->tag < 10;
2966 foreach my $subfield ( $field->subfields() ) {
2967 my $tag = $field->tag();
2968 my $subfieldcode = $subfield->[0];
2971 # check each index to see if the subfield is stored somewhere
2972 # otherwise, store it in __RAW__ index
2973 foreach my $key ( keys %index ) {
2975 # warn "examining $key index : ".$index{$key}." for $tag $subfieldcode";
2976 if ( $index{$key} =~ /$tag\*/ or $index{$key} =~ /$tag$subfieldcode/ ) {
2978 my $line = lc $subfield->[1];
2980 # remove meaningless value in the field...
2981 $line =~ s/-|\.|\?|,|;|!|'|\(|\)|\[|\]|{|}|"|<|>|&|\+|\*|\/|=|:/ /g;
2983 # ... and split in words
2984 foreach ( split / /, $line ) {
2985 next unless $_; # skip empty values (multiple spaces)
2986 # if the entry is already here, do nothing, the biblionumber has already be removed
2987 unless ( defined( $result{$key}->{$_} ) && ( $result{$key}->{$_} =~ /$biblionumber,$title\-(\d);/ ) ) {
2989 # get the index value if it exist in the nozebra table and remove the entry, otherwise, do nothing
2990 $sth2->execute( $server, $key, $_ );
2991 my $existing_biblionumbers = $sth2->fetchrow;
2994 if ($existing_biblionumbers) {
2996 # warn " existing for $key $_: $existing_biblionumbers";
2997 $result{$key}->{$_} = $existing_biblionumbers;
2998 $result{$key}->{$_} =~ s/$biblionumber,$title\-(\d);//;
3005 # the subfield is not indexed, store it in __RAW__ index anyway
3007 my $line = lc $subfield->[1];
3008 $line =~ s/-|\.|\?|,|;|!|'|\(|\)|\[|\]|{|}|"|<|>|&|\+|\*|\/|=|:/ /g;
3010 # ... and split in words
3011 foreach ( split / /, $line ) {
3012 next unless $_; # skip empty values (multiple spaces)
3013 # if the entry is already here, do nothing, the biblionumber has already be removed
3014 unless ( $result{'__RAW__'}->{$_} =~ /$biblionumber,$title\-(\d);/ ) {
3016 # get the index value if it exist in the nozebra table and remove the entry, otherwise, do nothing
3017 $sth2->execute( $server, '__RAW__', $_ );
3018 my $existing_biblionumbers = $sth2->fetchrow;
3021 if ($existing_biblionumbers) {
3022 $result{'__RAW__'}->{$_} = $existing_biblionumbers;
3023 $result{'__RAW__'}->{$_} =~ s/$biblionumber,$title\-(\d);//;
3033 =head2 _AddBiblioNoZebra
3035 _AddBiblioNoZebra($biblionumber, $record, $server, %result);
3037 function to add a biblio in NoZebra indexes
3041 sub _AddBiblioNoZebra {
3042 my ( $biblionumber, $record, $server, %result ) = @_;
3043 my $dbh = C4::Context->dbh;
3048 if ( $server eq 'biblioserver' ) {
3049 %index = GetNoZebraIndexes;
3051 # get title of the record (to store the 10 first letters with the index)
3052 my ( $titletag, $titlesubfield ) = GetMarcFromKohaField( 'biblio.title', '' ); # FIXME: should be GetFrameworkCode($biblionumber) ??
3053 $title = lc( $record->subfield( $titletag, $titlesubfield ) );
3056 # warn "server : $server";
3057 # for authorities, the "title" is the $a mainentry
3058 my ( $auth_type_tag, $auth_type_sf ) = C4::AuthoritiesMarc::get_auth_type_location();
3059 my $authref = C4::AuthoritiesMarc::GetAuthType( $record->subfield( $auth_type_tag, $auth_type_sf ) );
3060 warn "ERROR : authtype undefined for " . $record->as_formatted unless $authref;
3061 $title = $record->subfield( $authref->{auth_tag_to_report}, 'a' );
3062 $index{'mainmainentry'} = $authref->{auth_tag_to_report} . 'a';
3063 $index{'mainentry'} = $authref->{auth_tag_to_report} . '*';
3064 $index{'auth_type'} = "${auth_type_tag}${auth_type_sf}";
3067 # remove blancks comma (that could cause problem when decoding the string for CQL retrieval) and regexp specific values
3068 $title =~ s/ |\.|,|;|\[|\]|\(|\)|\*|-|'|:|=|\r|\n//g;
3070 # limit to 10 char, should be enough, and limit the DB size
3071 $title = substr( $title, 0, 10 );
3074 my $sth2 = $dbh->prepare('SELECT biblionumbers FROM nozebra WHERE server=? AND indexname=? AND value=?');
3075 foreach my $field ( $record->fields() ) {
3077 #parse each subfield
3078 ###FIXME: impossible to index a 001-009 value with NoZebra
3079 next if $field->tag < 10;
3080 foreach my $subfield ( $field->subfields() ) {
3081 my $tag = $field->tag();
3082 my $subfieldcode = $subfield->[0];
3085 # warn "INDEXING :".$subfield->[1];
3086 # check each index to see if the subfield is stored somewhere
3087 # otherwise, store it in __RAW__ index
3088 foreach my $key ( keys %index ) {
3090 # warn "examining $key index : ".$index{$key}." for $tag $subfieldcode";
3091 if ( $index{$key} =~ /$tag\*/ or $index{$key} =~ /$tag$subfieldcode/ ) {
3093 my $line = lc $subfield->[1];
3095 # remove meaningless value in the field...
3096 $line =~ s/-|\.|\?|,|;|!|'|\(|\)|\[|\]|{|}|"|<|>|&|\+|\*|\/|=|:|\r|\n/ /g;
3098 # ... and split in words
3099 foreach ( split / /, $line ) {
3100 next unless $_; # skip empty values (multiple spaces)
3101 # if the entry is already here, improve weight
3103 # warn "managing $_";
3104 if ( exists $result{$key}->{$_} && $result{$key}->{"$_"} =~ /$biblionumber,\Q$title\E\-(\d+);/ ) {
3105 my $weight = $1 + 1;
3106 $result{$key}->{"$_"} =~ s/$biblionumber,\Q$title\E\-(\d+);//g;
3107 $result{$key}->{"$_"} .= "$biblionumber,$title-$weight;";
3110 # get the value if it exist in the nozebra table, otherwise, create it
3111 $sth2->execute( $server, $key, $_ );
3112 my $existing_biblionumbers = $sth2->fetchrow;
3115 if ($existing_biblionumbers) {
3116 $result{$key}->{"$_"} = $existing_biblionumbers;
3117 my $weight = defined $1 ? $1 + 1 : 1;
3118 $result{$key}->{"$_"} =~ s/$biblionumber,\Q$title\E\-(\d+);//g;
3119 $result{$key}->{"$_"} .= "$biblionumber,$title-$weight;";
3121 # create a new ligne for this entry
3124 # warn "INSERT : $server / $key / $_";
3125 $dbh->do( 'INSERT INTO nozebra SET server=' . $dbh->quote($server) . ', indexname=' . $dbh->quote($key) . ',value=' . $dbh->quote($_) );
3126 $result{$key}->{"$_"} .= "$biblionumber,$title-1;";
3133 # the subfield is not indexed, store it in __RAW__ index anyway
3135 my $line = lc $subfield->[1];
3136 $line =~ s/-|\.|\?|,|;|!|'|\(|\)|\[|\]|{|}|"|<|>|&|\+|\*|\/|=|:|\r|\n/ /g;
3138 # ... and split in words
3139 foreach ( split / /, $line ) {
3140 next unless $_; # skip empty values (multiple spaces)
3141 # if the entry is already here, improve weight
3142 my $tmpstr = $result{'__RAW__'}->{"$_"} || "";
3143 if ( $tmpstr =~ /$biblionumber,\Q$title\E\-(\d+);/ ) {
3144 my $weight = $1 + 1;
3145 $result{'__RAW__'}->{"$_"} =~ s/$biblionumber,\Q$title\E\-(\d+);//;
3146 $result{'__RAW__'}->{"$_"} .= "$biblionumber,$title-$weight;";
3149 # get the value if it exist in the nozebra table, otherwise, create it
3150 $sth2->execute( $server, '__RAW__', $_ );
3151 my $existing_biblionumbers = $sth2->fetchrow;
3154 if ($existing_biblionumbers) {
3155 $result{'__RAW__'}->{"$_"} = $existing_biblionumbers;
3156 my $weight = ( $1 ? $1 : 0 ) + 1;
3157 $result{'__RAW__'}->{"$_"} =~ s/$biblionumber,\Q$title\E\-(\d+);//;
3158 $result{'__RAW__'}->{"$_"} .= "$biblionumber,$title-$weight;";
3160 # create a new ligne for this entry
3162 $dbh->do( 'INSERT INTO nozebra SET server=' . $dbh->quote($server) . ', indexname="__RAW__",value=' . $dbh->quote($_) );
3163 $result{'__RAW__'}->{"$_"} .= "$biblionumber,$title-1;";
3173 =head2 _koha_marc_update_bib_ids
3176 _koha_marc_update_bib_ids($record, $frameworkcode, $biblionumber, $biblioitemnumber);
3178 Internal function to add or update biblionumber and biblioitemnumber to
3183 sub _koha_marc_update_bib_ids {
3184 my ( $record, $frameworkcode, $biblionumber, $biblioitemnumber ) = @_;
3186 # we must add bibnum and bibitemnum in MARC::Record...
3187 # we build the new field with biblionumber and biblioitemnumber
3188 # we drop the original field
3189 # we add the new builded field.
3190 my ( $biblio_tag, $biblio_subfield ) = GetMarcFromKohaField( "biblio.biblionumber", $frameworkcode );
3191 die qq{No biblionumber tag for framework "$frameworkcode"} unless $biblio_tag;
3192 my ( $biblioitem_tag, $biblioitem_subfield ) = GetMarcFromKohaField( "biblioitems.biblioitemnumber", $frameworkcode );
3193 die qq{No biblioitemnumber tag for framework "$frameworkcode"} unless $biblioitem_tag;
3195 if ( $biblio_tag == $biblioitem_tag ) {
3197 # biblionumber & biblioitemnumber are in the same field (can't be <10 as fields <10 have only 1 value)
3198 my $new_field = MARC::Field->new(
3199 $biblio_tag, '', '',
3200 "$biblio_subfield" => $biblionumber,
3201 "$biblioitem_subfield" => $biblioitemnumber
3204 # drop old field and create new one...
3205 my $old_field = $record->field($biblio_tag);
3206 $record->delete_field($old_field) if $old_field;
3207 $record->insert_fields_ordered($new_field);
3210 # biblionumber & biblioitemnumber are in different fields
3212 # deal with biblionumber
3213 my ( $new_field, $old_field );
3214 if ( $biblio_tag < 10 ) {
3215 $new_field = MARC::Field->new( $biblio_tag, $biblionumber );
3217 $new_field = MARC::Field->new( $biblio_tag, '', '', "$biblio_subfield" => $biblionumber );
3220 # drop old field and create new one...
3221 $old_field = $record->field($biblio_tag);
3222 $record->delete_field($old_field) if $old_field;
3223 $record->insert_fields_ordered($new_field);
3225 # deal with biblioitemnumber
3226 if ( $biblioitem_tag < 10 ) {
3227 $new_field = MARC::Field->new( $biblioitem_tag, $biblioitemnumber, );
3229 $new_field = MARC::Field->new( $biblioitem_tag, '', '', "$biblioitem_subfield" => $biblioitemnumber, );
3232 # drop old field and create new one...
3233 $old_field = $record->field($biblioitem_tag);
3234 $record->delete_field($old_field) if $old_field;
3235 $record->insert_fields_ordered($new_field);
3239 =head2 _koha_marc_update_biblioitem_cn_sort
3241 _koha_marc_update_biblioitem_cn_sort($marc, $biblioitem, $frameworkcode);
3243 Given a MARC bib record and the biblioitem hash, update the
3244 subfield that contains a copy of the value of biblioitems.cn_sort.
3248 sub _koha_marc_update_biblioitem_cn_sort {
3250 my $biblioitem = shift;
3251 my $frameworkcode = shift;
3253 my ( $biblioitem_tag, $biblioitem_subfield ) = GetMarcFromKohaField( "biblioitems.cn_sort", $frameworkcode );
3254 return unless $biblioitem_tag;
3256 my ($cn_sort) = GetClassSort( $biblioitem->{'biblioitems.cn_source'}, $biblioitem->{'cn_class'}, $biblioitem->{'cn_item'} );
3258 if ( my $field = $marc->field($biblioitem_tag) ) {
3259 $field->delete_subfield( code => $biblioitem_subfield );
3260 if ( $cn_sort ne '' ) {
3261 $field->add_subfields( $biblioitem_subfield => $cn_sort );
3265 # if we get here, no biblioitem tag is present in the MARC record, so
3266 # we'll create it if $cn_sort is not empty -- this would be
3267 # an odd combination of events, however
3269 $marc->insert_grouped_field( MARC::Field->new( $biblioitem_tag, ' ', ' ', $biblioitem_subfield => $cn_sort ) );
3274 =head2 _koha_add_biblio
3276 my ($biblionumber,$error) = _koha_add_biblio($dbh,$biblioitem);
3278 Internal function to add a biblio ($biblio is a hash with the values)
3282 sub _koha_add_biblio {
3283 my ( $dbh, $biblio, $frameworkcode ) = @_;
3287 # set the series flag
3288 unless (defined $biblio->{'serial'}){
3289 $biblio->{'serial'} = 0;
3290 if ( $biblio->{'seriestitle'} ) { $biblio->{'serial'} = 1 }
3293 my $query = "INSERT INTO biblio
3294 SET frameworkcode = ?,
3305 my $sth = $dbh->prepare($query);
3307 $frameworkcode, $biblio->{'author'}, $biblio->{'title'}, $biblio->{'unititle'}, $biblio->{'notes'},
3308 $biblio->{'serial'}, $biblio->{'seriestitle'}, $biblio->{'copyrightdate'}, $biblio->{'abstract'}
3311 my $biblionumber = $dbh->{'mysql_insertid'};
3312 if ( $dbh->errstr ) {
3313 $error .= "ERROR in _koha_add_biblio $query" . $dbh->errstr;
3319 #warn "LEAVING _koha_add_biblio: ".$biblionumber."\n";
3320 return ( $biblionumber, $error );
3323 =head2 _koha_modify_biblio
3325 my ($biblionumber,$error) == _koha_modify_biblio($dbh,$biblio,$frameworkcode);
3327 Internal function for updating the biblio table
3331 sub _koha_modify_biblio {
3332 my ( $dbh, $biblio, $frameworkcode ) = @_;
3337 SET frameworkcode = ?,
3346 WHERE biblionumber = ?
3349 my $sth = $dbh->prepare($query);
3352 $frameworkcode, $biblio->{'author'}, $biblio->{'title'}, $biblio->{'unititle'}, $biblio->{'notes'},
3353 $biblio->{'serial'}, $biblio->{'seriestitle'}, $biblio->{'copyrightdate'}, $biblio->{'abstract'}, $biblio->{'biblionumber'}
3354 ) if $biblio->{'biblionumber'};
3356 if ( $dbh->errstr || !$biblio->{'biblionumber'} ) {
3357 $error .= "ERROR in _koha_modify_biblio $query" . $dbh->errstr;
3360 return ( $biblio->{'biblionumber'}, $error );
3363 =head2 _koha_modify_biblioitem_nonmarc
3365 my ($biblioitemnumber,$error) = _koha_modify_biblioitem_nonmarc( $dbh, $biblioitem );
3367 Updates biblioitems row except for marc and marcxml, which should be changed
3372 sub _koha_modify_biblioitem_nonmarc {
3373 my ( $dbh, $biblioitem ) = @_;
3376 # re-calculate the cn_sort, it may have changed
3377 my ($cn_sort) = GetClassSort( $biblioitem->{'biblioitems.cn_source'}, $biblioitem->{'cn_class'}, $biblioitem->{'cn_item'} );
3379 my $query = "UPDATE biblioitems
3380 SET biblionumber = ?,
3386 publicationyear = ?,
3390 collectiontitle = ?,
3392 collectionvolume= ?,
3393 editionstatement= ?,
3394 editionresponsibility = ?,
3410 where biblioitemnumber = ?
3412 my $sth = $dbh->prepare($query);
3414 $biblioitem->{'biblionumber'}, $biblioitem->{'volume'}, $biblioitem->{'number'}, $biblioitem->{'itemtype'},
3415 $biblioitem->{'isbn'}, $biblioitem->{'issn'}, $biblioitem->{'publicationyear'}, $biblioitem->{'publishercode'},
3416 $biblioitem->{'volumedate'}, $biblioitem->{'volumedesc'}, $biblioitem->{'collectiontitle'}, $biblioitem->{'collectionissn'},
3417 $biblioitem->{'collectionvolume'}, $biblioitem->{'editionstatement'}, $biblioitem->{'editionresponsibility'}, $biblioitem->{'illus'},
3418 $biblioitem->{'pages'}, $biblioitem->{'bnotes'}, $biblioitem->{'size'}, $biblioitem->{'place'},
3419 $biblioitem->{'lccn'}, $biblioitem->{'url'}, $biblioitem->{'biblioitems.cn_source'}, $biblioitem->{'cn_class'},
3420 $biblioitem->{'cn_item'}, $biblioitem->{'cn_suffix'}, $cn_sort, $biblioitem->{'totalissues'},
3421 $biblioitem->{'ean'}, $biblioitem->{'agerestriction'}, $biblioitem->{'biblioitemnumber'}
3423 if ( $dbh->errstr ) {
3424 $error .= "ERROR in _koha_modify_biblioitem_nonmarc $query" . $dbh->errstr;
3427 return ( $biblioitem->{'biblioitemnumber'}, $error );
3430 =head2 _koha_add_biblioitem
3432 my ($biblioitemnumber,$error) = _koha_add_biblioitem( $dbh, $biblioitem );
3434 Internal function to add a biblioitem
3438 sub _koha_add_biblioitem {
3439 my ( $dbh, $biblioitem ) = @_;
3442 my ($cn_sort) = GetClassSort( $biblioitem->{'biblioitems.cn_source'}, $biblioitem->{'cn_class'}, $biblioitem->{'cn_item'} );
3443 my $query = "INSERT INTO biblioitems SET
3450 publicationyear = ?,
3454 collectiontitle = ?,
3456 collectionvolume= ?,
3457 editionstatement= ?,
3458 editionresponsibility = ?,
3476 my $sth = $dbh->prepare($query);
3478 $biblioitem->{'biblionumber'}, $biblioitem->{'volume'}, $biblioitem->{'number'}, $biblioitem->{'itemtype'},
3479 $biblioitem->{'isbn'}, $biblioitem->{'issn'}, $biblioitem->{'publicationyear'}, $biblioitem->{'publishercode'},
3480 $biblioitem->{'volumedate'}, $biblioitem->{'volumedesc'}, $biblioitem->{'collectiontitle'}, $biblioitem->{'collectionissn'},
3481 $biblioitem->{'collectionvolume'}, $biblioitem->{'editionstatement'}, $biblioitem->{'editionresponsibility'}, $biblioitem->{'illus'},
3482 $biblioitem->{'pages'}, $biblioitem->{'bnotes'}, $biblioitem->{'size'}, $biblioitem->{'place'},
3483 $biblioitem->{'lccn'}, $biblioitem->{'marc'}, $biblioitem->{'url'}, $biblioitem->{'biblioitems.cn_source'},
3484 $biblioitem->{'cn_class'}, $biblioitem->{'cn_item'}, $biblioitem->{'cn_suffix'}, $cn_sort,
3485 $biblioitem->{'totalissues'}, $biblioitem->{'ean'}, $biblioitem->{'agerestriction'}
3487 my $bibitemnum = $dbh->{'mysql_insertid'};
3489 if ( $dbh->errstr ) {
3490 $error .= "ERROR in _koha_add_biblioitem $query" . $dbh->errstr;
3494 return ( $bibitemnum, $error );
3497 =head2 _koha_delete_biblio
3499 $error = _koha_delete_biblio($dbh,$biblionumber);
3501 Internal sub for deleting from biblio table -- also saves to deletedbiblio
3503 C<$dbh> - the database handle
3505 C<$biblionumber> - the biblionumber of the biblio to be deleted
3509 # FIXME: add error handling
3511 sub _koha_delete_biblio {
3512 my ( $dbh, $biblionumber ) = @_;
3514 # get all the data for this biblio
3515 my $sth = $dbh->prepare("SELECT * FROM biblio WHERE biblionumber=?");
3516 $sth->execute($biblionumber);
3518 if ( my $data = $sth->fetchrow_hashref ) {
3520 # save the record in deletedbiblio
3521 # find the fields to save
3522 my $query = "INSERT INTO deletedbiblio SET ";
3524 foreach my $temp ( keys %$data ) {
3525 $query .= "$temp = ?,";
3526 push( @bind, $data->{$temp} );
3529 # replace the last , by ",?)"
3531 my $bkup_sth = $dbh->prepare($query);
3532 $bkup_sth->execute(@bind);
3536 my $sth2 = $dbh->prepare("DELETE FROM biblio WHERE biblionumber=?");
3537 $sth2->execute($biblionumber);
3538 # update the timestamp (Bugzilla 7146)
3539 $sth2= $dbh->prepare("UPDATE deletedbiblio SET timestamp=NOW() WHERE biblionumber=?");
3540 $sth2->execute($biblionumber);
3547 =head2 _koha_delete_biblioitems
3549 $error = _koha_delete_biblioitems($dbh,$biblioitemnumber);
3551 Internal sub for deleting from biblioitems table -- also saves to deletedbiblioitems
3553 C<$dbh> - the database handle
3554 C<$biblionumber> - the biblioitemnumber of the biblioitem to be deleted
3558 # FIXME: add error handling
3560 sub _koha_delete_biblioitems {
3561 my ( $dbh, $biblioitemnumber ) = @_;
3563 # get all the data for this biblioitem
3564 my $sth = $dbh->prepare("SELECT * FROM biblioitems WHERE biblioitemnumber=?");
3565 $sth->execute($biblioitemnumber);
3567 if ( my $data = $sth->fetchrow_hashref ) {
3569 # save the record in deletedbiblioitems
3570 # find the fields to save
3571 my $query = "INSERT INTO deletedbiblioitems SET ";
3573 foreach my $temp ( keys %$data ) {
3574 $query .= "$temp = ?,";
3575 push( @bind, $data->{$temp} );
3578 # replace the last , by ",?)"
3580 my $bkup_sth = $dbh->prepare($query);
3581 $bkup_sth->execute(@bind);
3584 # delete the biblioitem
3585 my $sth2 = $dbh->prepare("DELETE FROM biblioitems WHERE biblioitemnumber=?");
3586 $sth2->execute($biblioitemnumber);
3587 # update the timestamp (Bugzilla 7146)
3588 $sth2= $dbh->prepare("UPDATE deletedbiblioitems SET timestamp=NOW() WHERE biblioitemnumber=?");
3589 $sth2->execute($biblioitemnumber);
3596 =head1 UNEXPORTED FUNCTIONS
3598 =head2 ModBiblioMarc
3600 &ModBiblioMarc($newrec,$biblionumber,$frameworkcode);
3602 Add MARC data for a biblio to koha
3604 Function exported, but should NOT be used, unless you really know what you're doing
3609 # pass the MARC::Record to this function, and it will create the records in
3611 my ( $record, $biblionumber, $frameworkcode ) = @_;
3613 # Clone record as it gets modified
3614 $record = $record->clone();
3615 my $dbh = C4::Context->dbh;
3616 my @fields = $record->fields();
3617 if ( !$frameworkcode ) {
3618 $frameworkcode = "";
3620 my $sth = $dbh->prepare("UPDATE biblio SET frameworkcode=? WHERE biblionumber=?");
3621 $sth->execute( $frameworkcode, $biblionumber );
3623 my $encoding = C4::Context->preference("marcflavour");
3625 # deal with UNIMARC field 100 (encoding) : create it if needed & set encoding to unicode
3626 if ( $encoding eq "UNIMARC" ) {
3627 my $string = $record->subfield( 100, "a" );
3628 if ( ($string) && ( length( $record->subfield( 100, "a" ) ) == 36 ) ) {
3629 my $f100 = $record->field(100);
3630 $record->delete_field($f100);
3632 $string = POSIX::strftime( "%Y%m%d", localtime );
3634 $string = sprintf( "%-*s", 35, $string );
3636 substr( $string, 22, 6, "frey50" );
3637 unless ( $record->subfield( 100, "a" ) ) {
3638 $record->insert_fields_ordered( MARC::Field->new( 100, "", "", "a" => $string ) );
3642 #enhancement 5374: update transaction date (005) for marc21/unimarc
3643 if($encoding =~ /MARC21|UNIMARC/) {
3644 my @a= (localtime) [5,4,3,2,1,0]; $a[0]+=1900; $a[1]++;
3645 # YY MM DD HH MM SS (update year and month)
3646 my $f005= $record->field('005');
3647 $f005->update(sprintf("%4d%02d%02d%02d%02d%04.1f",@a)) if $f005;
3651 if ( C4::Context->preference("NoZebra") ) {
3653 # only NoZebra indexing needs to have
3654 # the previous version of the record
3655 $oldRecord = GetMarcBiblio($biblionumber);
3657 $sth = $dbh->prepare("UPDATE biblioitems SET marc=?,marcxml=? WHERE biblionumber=?");
3658 $sth->execute( $record->as_usmarc(), $record->as_xml_record($encoding), $biblionumber );
3660 ModZebra( $biblionumber, "specialUpdate", "biblioserver", $oldRecord, $record );
3661 return $biblionumber;
3664 =head2 get_biblio_authorised_values
3666 find the types and values for all authorised values assigned to this biblio.
3670 MARC::Record of the bib
3672 returns: a hashref mapping the authorised value to the value set for this biblionumber
3674 $authorised_values = {
3675 'Scent' => 'flowery',
3676 'Audience' => 'Young Adult',
3677 'itemtypes' => 'SER',
3680 Notes: forlibrarian should probably be passed in, and called something different.
3684 sub get_biblio_authorised_values {
3685 my $biblionumber = shift;
3688 my $forlibrarian = 1; # are we in staff or opac?
3689 my $frameworkcode = GetFrameworkCode($biblionumber);
3691 my $authorised_values;
3693 my $tagslib = GetMarcStructure( $forlibrarian, $frameworkcode )
3694 or return $authorised_values;
3696 # assume that these entries in the authorised_value table are bibliolevel.
3697 # ones that start with 'item%' are item level.
3698 my $query = q(SELECT distinct authorised_value, kohafield
3699 FROM marc_subfield_structure
3700 WHERE authorised_value !=''
3701 AND (kohafield like 'biblio%'
3702 OR kohafield like '') );
3703 my $bibliolevel_authorised_values = C4::Context->dbh->selectall_hashref( $query, 'authorised_value' );
3705 foreach my $tag ( keys(%$tagslib) ) {
3706 foreach my $subfield ( keys( %{ $tagslib->{$tag} } ) ) {
3708 # warn "checking $subfield. type is: " . ref $tagslib->{ $tag }{ $subfield };
3709 if ( 'HASH' eq ref $tagslib->{$tag}{$subfield} ) {
3710 if ( defined $tagslib->{$tag}{$subfield}{'authorised_value'} && exists $bibliolevel_authorised_values->{ $tagslib->{$tag}{$subfield}{'authorised_value'} } ) {
3711 if ( defined $record->field($tag) ) {
3712 my $this_subfield_value = $record->field($tag)->subfield($subfield);
3713 if ( defined $this_subfield_value ) {
3714 $authorised_values->{ $tagslib->{$tag}{$subfield}{'authorised_value'} } = $this_subfield_value;
3722 # warn ( Data::Dumper->Dump( [ $authorised_values ], [ 'authorised_values' ] ) );
3723 return $authorised_values;
3726 =head2 CountBiblioInOrders
3729 $count = &CountBiblioInOrders( $biblionumber);
3733 This function return count of biblios in orders with $biblionumber
3737 sub CountBiblioInOrders {
3738 my ($biblionumber) = @_;
3739 my $dbh = C4::Context->dbh;
3740 my $query = "SELECT count(*)
3742 WHERE biblionumber=? AND (datecancellationprinted IS NULL OR datecancellationprinted='0000-00-00')";
3743 my $sth = $dbh->prepare($query);
3744 $sth->execute($biblionumber);
3745 my $count = $sth->fetchrow;
3749 =head2 GetSubscriptionsId
3752 $subscriptions = &GetSubscriptionsId($biblionumber);
3756 This function return an array of subscriptionid with $biblionumber
3760 sub GetSubscriptionsId {
3761 my ($biblionumber) = @_;
3762 my $dbh = C4::Context->dbh;
3763 my $query = "SELECT subscriptionid
3765 WHERE biblionumber=?";
3766 my $sth = $dbh->prepare($query);
3767 $sth->execute($biblionumber);
3768 my @subscriptions = $sth->fetchrow_array;
3769 return (@subscriptions);
3775 $holds = &GetHolds($biblionumber);
3779 This function return the count of holds with $biblionumber
3784 my ($biblionumber) = @_;
3785 my $dbh = C4::Context->dbh;
3786 my $query = "SELECT count(*)
3788 WHERE biblionumber=?";
3789 my $sth = $dbh->prepare($query);
3790 $sth->execute($biblionumber);
3791 my $holds = $sth->fetchrow;
3795 =head2 prepare_host_field
3797 $marcfield = prepare_host_field( $hostbiblioitem, $marcflavour );
3798 Generate the host item entry for an analytic child entry
3802 sub prepare_host_field {
3803 my ( $hostbiblio, $marcflavour ) = @_;
3804 $marcflavour ||= C4::Context->preference('marcflavour');
3805 my $host = GetMarcBiblio($hostbiblio);
3806 # unfortunately as_string does not 'do the right thing'
3807 # if field returns undef
3811 if ( $marcflavour eq 'MARC21' || $marcflavour eq 'NORMARC' ) {
3812 if ( $field = $host->field('100') || $host->field('110') || $host->field('11') ) {
3813 my $s = $field->as_string('ab');
3818 if ( $field = $host->field('245') ) {
3819 my $s = $field->as_string('a');
3824 if ( $field = $host->field('260') ) {
3825 my $s = $field->as_string('abc');
3830 if ( $field = $host->field('240') ) {
3831 my $s = $field->as_string();
3836 if ( $field = $host->field('022') ) {
3837 my $s = $field->as_string('a');
3842 if ( $field = $host->field('020') ) {
3843 my $s = $field->as_string('a');
3848 if ( $field = $host->field('001') ) {
3849 $sfd{w} = $field->data(),;
3851 $host_field = MARC::Field->new( 773, '0', ' ', %sfd );
3854 elsif ( $marcflavour eq 'UNIMARC' ) {
3856 if ( $field = $host->field('700') || $host->field('710') || $host->field('720') ) {
3857 my $s = $field->as_string('ab');
3863 if ( $field = $host->field('200') ) {
3864 my $s = $field->as_string('a');
3869 #place of publicaton
3870 if ( $field = $host->field('210') ) {
3871 my $s = $field->as_string('a');
3876 #date of publication
3877 if ( $field = $host->field('210') ) {
3878 my $s = $field->as_string('d');
3884 if ( $field = $host->field('205') ) {
3885 my $s = $field->as_string();
3891 if ( $field = $host->field('856') ) {
3892 my $s = $field->as_string('u');
3898 if ( $field = $host->field('011') ) {
3899 my $s = $field->as_string('a');
3905 if ( $field = $host->field('010') ) {
3906 my $s = $field->as_string('a');
3911 if ( $field = $host->field('001') ) {
3912 $sfd{0} = $field->data(),;
3914 $host_field = MARC::Field->new( 461, '0', ' ', %sfd );
3921 =head2 UpdateTotalIssues
3923 UpdateTotalIssues($biblionumber, $increase, [$value])
3925 Update the total issue count for a particular bib record.
3929 =item C<$biblionumber> is the biblionumber of the bib to update
3931 =item C<$increase> is the amount to increase (or decrease) the total issues count by
3933 =item C<$value> is the absolute value that total issues count should be set to. If provided, C<$increase> is ignored.
3939 sub UpdateTotalIssues {
3940 my ($biblionumber, $increase, $value) = @_;
3943 my $data = GetBiblioData($biblionumber);
3945 if (defined $value) {
3946 $totalissues = $value;
3948 $totalissues = $data->{'totalissues'} + $increase;
3950 my ($totalissuestag, $totalissuessubfield) = GetMarcFromKohaField('biblioitems.totalissues', $data->{'frameworkcode'});
3952 my $record = GetMarcBiblio($biblionumber);
3954 my $field = $record->field($totalissuestag);
3955 if (defined $field) {
3956 $field->update( $totalissuessubfield => $totalissues );
3958 $field = MARC::Field->new($totalissuestag, '0', '0',
3959 $totalissuessubfield => $totalissues);
3960 $record->insert_grouped_field($field);
3963 ModBiblio($record, $biblionumber, $data->{'frameworkcode'});
3969 &RemoveAllNsb($record);
3971 Removes all nsb/nse chars from a record
3978 SetUTF8Flag($record);
3980 foreach my $field ($record->fields()) {
3981 if ($field->is_control_field()) {
3982 $field->update(nsb_clean($field->data()));
3984 my @subfields = $field->subfields();
3986 foreach my $subfield (@subfields) {
3987 push @new_subfields, $subfield->[0] => nsb_clean($subfield->[1]);
3989 if (scalar(@new_subfields) > 0) {
3992 $new_field = MARC::Field->new(
3994 $field->indicator(1),
3995 $field->indicator(2),
4000 warn "error in RemoveAllNsb : $@";
4002 $field->replace_with($new_field);
4018 Koha Development Team <http://koha-community.org/>
4020 Paul POULAIN paul.poulain@free.fr
4022 Joshua Ferraro jmf@liblime.com