3 # Copyright 2000-2002 Katipo Communications
4 # Copyright 2010 BibLibre
5 # Copyright 2011 Equinox Software, Inc.
7 # This file is part of Koha.
9 # Koha is free software; you can redistribute it and/or modify it under the
10 # terms of the GNU General Public License as published by the Free Software
11 # Foundation; either version 2 of the License, or (at your option) any later
14 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
15 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
16 # A PARTICULAR PURPOSE. See the GNU General Public License for more details.
18 # You should have received a copy of the GNU General Public License along
19 # with Koha; if not, write to the Free Software Foundation, Inc.,
20 # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
28 use MARC::File::USMARC;
30 use POSIX qw(strftime);
33 use C4::Dates qw/format_date/;
34 use C4::Log; # logaction
38 use vars qw($VERSION @ISA @EXPORT);
44 @ISA = qw( Exporter );
59 &GetBiblioItemByBiblioNumber
60 &GetBiblioFromItemNumber
61 &GetBiblionumberFromItemnumber
86 &GetAuthorisedValueDesc
106 # To delete something
111 # To link headings in a bib record
112 # to authority records.
114 &LinkBibHeadingsToAuthorities
118 # those functions are exported but should not be used
119 # they are usefull is few circumstances, so are exported.
120 # but don't use them unless you're a core developer ;-)
128 &TransformHtmlToMarc2
136 if (C4::Context->ismemcached) {
137 require Memoize::Memcached;
138 import Memoize::Memcached qw(memoize_memcached);
140 memoize_memcached( 'GetMarcStructure',
141 memcached => C4::Context->memcached);
147 C4::Biblio - cataloging management functions
151 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:
155 =item 1. in the biblio,biblioitems,items, etc tables, which are limited to a one-to-one mapping to underlying MARC data
157 =item 2. as raw MARC in the Zebra index and storage engine
159 =item 3. as raw MARC the biblioitems.marc and biblioitems.marcxml
163 In the 3.0 version of Koha, the authoritative record-level information is in biblioitems.marcxml
165 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.
169 =item 1. Compared with MySQL, Zebra is slow to update an index for small data changes -- especially for proc-intensive operations like circulation
171 =item 2. Zebra's index has been known to crash and a backup of the data is necessary to rebuild it in such cases
175 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:
179 =item 1. Add*/Mod*/Del*/ - high-level external functions suitable for being called from external scripts to manage the collection
181 =item 2. _koha_* - low-level internal functions for managing the koha tables
183 =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.
185 =item 4. Zebra functions used to update the Zebra index
187 =item 5. internal helper functions such as char_decode, checkitems, etc. Some of these probably belong in Koha.pm
191 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 :
195 =item 1. save datas in biblio and biblioitems table, that gives us a biblionumber and a biblioitemnumber
197 =item 2. add the biblionumber and biblioitemnumber into the MARC records
199 =item 3. save the marc record
203 When dealing with items, we must :
207 =item 1. save the item in items table, that gives us an itemnumber
209 =item 2. add the itemnumber to the item MARC field
211 =item 3. overwrite the MARC record (with the added item) into biblioitems.marc(xml)
213 When modifying a biblio or an item, the behaviour is quite similar.
217 =head1 EXPORTED FUNCTIONS
221 ($biblionumber,$biblioitemnumber) = AddBiblio($record,$frameworkcode);
223 Exported function (core API) for adding a new biblio to koha.
225 The first argument is a C<MARC::Record> object containing the
226 bib to add, while the second argument is the desired MARC
229 This function also accepts a third, optional argument: a hashref
230 to additional options. The only defined option is C<defer_marc_save>,
231 which if present and mapped to a true value, causes C<AddBiblio>
232 to omit the call to save the MARC in C<bibilioitems.marc>
233 and C<biblioitems.marcxml> This option is provided B<only>
234 for the use of scripts such as C<bulkmarcimport.pl> that may need
235 to do some manipulation of the MARC record for item parsing before
236 saving it and which cannot afford the performance hit of saving
237 the MARC record twice. Consequently, do not use that option
238 unless you can guarantee that C<ModBiblioMarc> will be called.
244 my $frameworkcode = shift;
245 my $options = @_ ? shift : undef;
246 my $defer_marc_save = 0;
247 if ( defined $options and exists $options->{'defer_marc_save'} and $options->{'defer_marc_save'} ) {
248 $defer_marc_save = 1;
251 my ( $biblionumber, $biblioitemnumber, $error );
252 my $dbh = C4::Context->dbh;
254 # transform the data into koha-table style data
255 SetUTF8Flag($record);
256 my $olddata = TransformMarcToKoha( $dbh, $record, $frameworkcode );
257 ( $biblionumber, $error ) = _koha_add_biblio( $dbh, $olddata, $frameworkcode );
258 $olddata->{'biblionumber'} = $biblionumber;
259 ( $biblioitemnumber, $error ) = _koha_add_biblioitem( $dbh, $olddata );
261 _koha_marc_update_bib_ids( $record, $frameworkcode, $biblionumber, $biblioitemnumber );
263 # update MARC subfield that stores biblioitems.cn_sort
264 _koha_marc_update_biblioitem_cn_sort( $record, $olddata, $frameworkcode );
267 ModBiblioMarc( $record, $biblionumber, $frameworkcode ) unless $defer_marc_save;
269 logaction( "CATALOGUING", "ADD", $biblionumber, "biblio" ) if C4::Context->preference("CataloguingLog");
270 return ( $biblionumber, $biblioitemnumber );
275 ModBiblio( $record,$biblionumber,$frameworkcode);
277 Replace an existing bib record identified by C<$biblionumber>
278 with one supplied by the MARC::Record object C<$record>. The embedded
279 item, biblioitem, and biblionumber fields from the previous
280 version of the bib record replace any such fields of those tags that
281 are present in C<$record>. Consequently, ModBiblio() is not
282 to be used to try to modify item records.
284 C<$frameworkcode> specifies the MARC framework to use
285 when storing the modified bib record; among other things,
286 this controls how MARC fields get mapped to display columns
287 in the C<biblio> and C<biblioitems> tables, as well as
288 which fields are used to store embedded item, biblioitem,
289 and biblionumber data for indexing.
294 my ( $record, $biblionumber, $frameworkcode ) = @_;
295 croak "No record" unless $record;
297 if ( C4::Context->preference("CataloguingLog") ) {
298 my $newrecord = GetMarcBiblio($biblionumber);
299 logaction( "CATALOGUING", "MODIFY", $biblionumber, "BEFORE=>" . $newrecord->as_formatted );
302 # Cleaning up invalid fields must be done early or SetUTF8Flag is liable to
303 # throw an exception which probably won't be handled.
304 foreach my $field ($record->fields()) {
305 if (! $field->is_control_field()) {
306 if (scalar($field->subfields()) == 0 || (scalar($field->subfields()) == 1 && $field->subfield('9'))) {
307 $record->delete_field($field);
312 SetUTF8Flag($record);
313 my $dbh = C4::Context->dbh;
315 $frameworkcode = "" if !$frameworkcode || $frameworkcode eq "Default"; # XXX
317 _strip_item_fields($record, $frameworkcode);
319 # update biblionumber and biblioitemnumber in MARC
320 # FIXME - this is assuming a 1 to 1 relationship between
321 # biblios and biblioitems
322 my $sth = $dbh->prepare("select biblioitemnumber from biblioitems where biblionumber=?");
323 $sth->execute($biblionumber);
324 my ($biblioitemnumber) = $sth->fetchrow;
326 _koha_marc_update_bib_ids( $record, $frameworkcode, $biblionumber, $biblioitemnumber );
328 # load the koha-table data object
329 my $oldbiblio = TransformMarcToKoha( $dbh, $record, $frameworkcode );
331 # update MARC subfield that stores biblioitems.cn_sort
332 _koha_marc_update_biblioitem_cn_sort( $record, $oldbiblio, $frameworkcode );
334 # update the MARC record (that now contains biblio and items) with the new record data
335 &ModBiblioMarc( $record, $biblionumber, $frameworkcode );
337 # modify the other koha tables
338 _koha_modify_biblio( $dbh, $oldbiblio, $frameworkcode );
339 _koha_modify_biblioitem_nonmarc( $dbh, $oldbiblio );
343 =head2 _strip_item_fields
345 _strip_item_fields($record, $frameworkcode)
347 Utility routine to remove item tags from a
352 sub _strip_item_fields {
354 my $frameworkcode = shift;
355 # get the items before and append them to the biblio before updating the record, atm we just have the biblio
356 my ( $itemtag, $itemsubfield ) = GetMarcFromKohaField( "items.itemnumber", $frameworkcode );
358 # delete any item fields from incoming record to avoid
359 # duplication or incorrect data - use AddItem() or ModItem()
361 foreach my $field ( $record->field($itemtag) ) {
362 $record->delete_field($field);
366 =head2 ModBiblioframework
368 ModBiblioframework($biblionumber,$frameworkcode);
370 Exported function to modify a biblio framework
374 sub ModBiblioframework {
375 my ( $biblionumber, $frameworkcode ) = @_;
376 my $dbh = C4::Context->dbh;
377 my $sth = $dbh->prepare( "UPDATE biblio SET frameworkcode=? WHERE biblionumber=?" );
378 $sth->execute( $frameworkcode, $biblionumber );
384 my $error = &DelBiblio($biblionumber);
386 Exported function (core API) for deleting a biblio in koha.
387 Deletes biblio record from Zebra and Koha tables (biblio,biblioitems,items)
388 Also backs it up to deleted* tables
389 Checks to make sure there are not issues on any of the items
391 C<$error> : undef unless an error occurs
396 my ($biblionumber) = @_;
397 my $dbh = C4::Context->dbh;
398 my $error; # for error handling
400 # First make sure this biblio has no items attached
401 my $sth = $dbh->prepare("SELECT itemnumber FROM items WHERE biblionumber=?");
402 $sth->execute($biblionumber);
403 if ( my $itemnumber = $sth->fetchrow ) {
405 # Fix this to use a status the template can understand
406 $error .= "This Biblio has items attached, please delete them first before deleting this biblio ";
409 return $error if $error;
411 # We delete attached subscriptions
413 my $subscriptions = C4::Serials::GetFullSubscriptionsFromBiblionumber($biblionumber);
414 foreach my $subscription (@$subscriptions) {
415 C4::Serials::DelSubscription( $subscription->{subscriptionid} );
418 # Delete in Zebra. Be careful NOT to move this line after _koha_delete_biblio
419 # for at least 2 reasons :
420 # - we need to read the biblio if NoZebra is set (to remove it from the indexes
421 # - if something goes wrong, the biblio may be deleted from Koha but not from zebra
422 # 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)
424 if ( C4::Context->preference("NoZebra") ) {
426 # only NoZebra indexing needs to have
427 # the previous version of the record
428 $oldRecord = GetMarcBiblio($biblionumber);
430 ModZebra( $biblionumber, "recordDelete", "biblioserver", $oldRecord, undef );
432 # delete biblioitems and items from Koha tables and save in deletedbiblioitems,deleteditems
433 $sth = $dbh->prepare("SELECT biblioitemnumber FROM biblioitems WHERE biblionumber=?");
434 $sth->execute($biblionumber);
435 while ( my $biblioitemnumber = $sth->fetchrow ) {
437 # delete this biblioitem
438 $error = _koha_delete_biblioitems( $dbh, $biblioitemnumber );
439 return $error if $error;
442 # delete biblio from Koha tables and save in deletedbiblio
443 # must do this *after* _koha_delete_biblioitems, otherwise
444 # delete cascade will prevent deletedbiblioitems rows
445 # from being generated by _koha_delete_biblioitems
446 $error = _koha_delete_biblio( $dbh, $biblionumber );
448 logaction( "CATALOGUING", "DELETE", $biblionumber, "" ) if C4::Context->preference("CataloguingLog");
453 =head2 LinkBibHeadingsToAuthorities
455 my $headings_linked = LinkBibHeadingsToAuthorities($marc);
457 Links bib headings to authority records by checking
458 each authority-controlled field in the C<MARC::Record>
459 object C<$marc>, looking for a matching authority record,
460 and setting the linking subfield $9 to the ID of that
463 If no matching authority exists, or if multiple
464 authorities match, no $9 will be added, and any
465 existing one inthe field will be deleted.
467 Returns the number of heading links changed in the
472 sub LinkBibHeadingsToAuthorities {
476 my $num_headings_changed = 0;
477 foreach my $field ( $bib->fields() ) {
478 my $heading = C4::Heading->new_from_bib_field($field);
479 next unless defined $heading;
482 my $current_link = $field->subfield('9');
484 # look for matching authorities
485 my $authorities = $heading->authorities();
487 # want only one exact match
488 if ( $#{$authorities} == 0 ) {
489 my $authority = MARC::Record->new_from_usmarc( $authorities->[0] );
490 my $authid = $authority->field('001')->data();
491 next if defined $current_link and $current_link eq $authid;
493 $field->delete_subfield( code => '9' ) if defined $current_link;
494 $field->add_subfields( '9', $authid );
495 $num_headings_changed++;
497 if ( defined $current_link ) {
498 $field->delete_subfield( code => '9' );
499 $num_headings_changed++;
504 return $num_headings_changed;
507 =head2 GetRecordValue
509 my $values = GetRecordValue($field, $record, $frameworkcode);
511 Get MARC fields from a keyword defined in fieldmapping table.
516 my ( $field, $record, $frameworkcode ) = @_;
517 my $dbh = C4::Context->dbh;
519 my $sth = $dbh->prepare('SELECT fieldcode, subfieldcode FROM fieldmapping WHERE frameworkcode = ? AND field = ?');
520 $sth->execute( $frameworkcode, $field );
524 while ( my $row = $sth->fetchrow_hashref ) {
525 foreach my $field ( $record->field( $row->{fieldcode} ) ) {
526 if ( ( $row->{subfieldcode} ne "" && $field->subfield( $row->{subfieldcode} ) ) ) {
527 foreach my $subfield ( $field->subfield( $row->{subfieldcode} ) ) {
528 push @result, { 'subfield' => $subfield };
531 } elsif ( $row->{subfieldcode} eq "" ) {
532 push @result, { 'subfield' => $field->as_string() };
540 =head2 SetFieldMapping
542 SetFieldMapping($framework, $field, $fieldcode, $subfieldcode);
544 Set a Field to MARC mapping value, if it already exists we don't add a new one.
548 sub SetFieldMapping {
549 my ( $framework, $field, $fieldcode, $subfieldcode ) = @_;
550 my $dbh = C4::Context->dbh;
552 my $sth = $dbh->prepare('SELECT * FROM fieldmapping WHERE fieldcode = ? AND subfieldcode = ? AND frameworkcode = ? AND field = ?');
553 $sth->execute( $fieldcode, $subfieldcode, $framework, $field );
554 if ( not $sth->fetchrow_hashref ) {
556 $sth = $dbh->prepare('INSERT INTO fieldmapping (fieldcode, subfieldcode, frameworkcode, field) VALUES(?,?,?,?)');
558 $sth->execute( $fieldcode, $subfieldcode, $framework, $field );
562 =head2 DeleteFieldMapping
564 DeleteFieldMapping($id);
566 Delete a field mapping from an $id.
570 sub DeleteFieldMapping {
572 my $dbh = C4::Context->dbh;
574 my $sth = $dbh->prepare('DELETE FROM fieldmapping WHERE id = ?');
578 =head2 GetFieldMapping
580 GetFieldMapping($frameworkcode);
582 Get all field mappings for a specified frameworkcode
586 sub GetFieldMapping {
587 my ($framework) = @_;
588 my $dbh = C4::Context->dbh;
590 my $sth = $dbh->prepare('SELECT * FROM fieldmapping where frameworkcode = ?');
591 $sth->execute($framework);
594 while ( my $row = $sth->fetchrow_hashref ) {
602 $data = &GetBiblioData($biblionumber);
604 Returns information about the book with the given biblionumber.
605 C<&GetBiblioData> returns a reference-to-hash. The keys are the fields in
606 the C<biblio> and C<biblioitems> tables in the
609 In addition, C<$data-E<gt>{subject}> is the list of the book's
610 subjects, separated by C<" , "> (space, comma, space).
611 If there are multiple biblioitems with the given biblionumber, only
612 the first one is considered.
618 my $dbh = C4::Context->dbh;
620 # my $query = C4::Context->preference('item-level_itypes') ?
621 # " SELECT * , biblioitems.notes AS bnotes, biblio.notes
623 # LEFT JOIN biblioitems ON biblio.biblionumber = biblioitems.biblionumber
624 # WHERE biblio.biblionumber = ?
625 # AND biblioitems.biblionumber = biblio.biblionumber
628 my $query = " SELECT * , biblioitems.notes AS bnotes, itemtypes.notforloan as bi_notforloan, biblio.notes
630 LEFT JOIN biblioitems ON biblio.biblionumber = biblioitems.biblionumber
631 LEFT JOIN itemtypes ON biblioitems.itemtype = itemtypes.itemtype
632 WHERE biblio.biblionumber = ?
633 AND biblioitems.biblionumber = biblio.biblionumber ";
635 my $sth = $dbh->prepare($query);
636 $sth->execute($bibnum);
638 $data = $sth->fetchrow_hashref;
642 } # sub GetBiblioData
644 =head2 &GetBiblioItemData
646 $itemdata = &GetBiblioItemData($biblioitemnumber);
648 Looks up the biblioitem with the given biblioitemnumber. Returns a
649 reference-to-hash. The keys are the fields from the C<biblio>,
650 C<biblioitems>, and C<itemtypes> tables in the Koha database, except
651 that C<biblioitems.notes> is given as C<$itemdata-E<gt>{bnotes}>.
656 sub GetBiblioItemData {
657 my ($biblioitemnumber) = @_;
658 my $dbh = C4::Context->dbh;
659 my $query = "SELECT *,biblioitems.notes AS bnotes
660 FROM biblio LEFT JOIN biblioitems on biblio.biblionumber=biblioitems.biblionumber ";
661 unless ( C4::Context->preference('item-level_itypes') ) {
662 $query .= "LEFT JOIN itemtypes on biblioitems.itemtype=itemtypes.itemtype ";
664 $query .= " WHERE biblioitemnumber = ? ";
665 my $sth = $dbh->prepare($query);
667 $sth->execute($biblioitemnumber);
668 $data = $sth->fetchrow_hashref;
671 } # sub &GetBiblioItemData
673 =head2 GetBiblioItemByBiblioNumber
675 NOTE : This function has been copy/paste from C4/Biblio.pm from head before zebra integration.
679 sub GetBiblioItemByBiblioNumber {
680 my ($biblionumber) = @_;
681 my $dbh = C4::Context->dbh;
682 my $sth = $dbh->prepare("Select * FROM biblioitems WHERE biblionumber = ?");
686 $sth->execute($biblionumber);
688 while ( my $data = $sth->fetchrow_hashref ) {
689 push @results, $data;
696 =head2 GetBiblionumberFromItemnumber
701 sub GetBiblionumberFromItemnumber {
702 my ($itemnumber) = @_;
703 my $dbh = C4::Context->dbh;
704 my $sth = $dbh->prepare("Select biblionumber FROM items WHERE itemnumber = ?");
706 $sth->execute($itemnumber);
707 my ($result) = $sth->fetchrow;
711 =head2 GetBiblioFromItemNumber
713 $item = &GetBiblioFromItemNumber($itemnumber,$barcode);
715 Looks up the item with the given itemnumber. if undef, try the barcode.
717 C<&itemnodata> returns a reference-to-hash whose keys are the fields
718 from the C<biblio>, C<biblioitems>, and C<items> tables in the Koha
724 sub GetBiblioFromItemNumber {
725 my ( $itemnumber, $barcode ) = @_;
726 my $dbh = C4::Context->dbh;
729 $sth = $dbh->prepare(
731 LEFT JOIN biblio ON biblio.biblionumber = items.biblionumber
732 LEFT JOIN biblioitems ON biblioitems.biblioitemnumber = items.biblioitemnumber
733 WHERE items.itemnumber = ?"
735 $sth->execute($itemnumber);
737 $sth = $dbh->prepare(
739 LEFT JOIN biblio ON biblio.biblionumber = items.biblionumber
740 LEFT JOIN biblioitems ON biblioitems.biblioitemnumber = items.biblioitemnumber
741 WHERE items.barcode = ?"
743 $sth->execute($barcode);
745 my $data = $sth->fetchrow_hashref;
752 $isbd = &GetISBDView($biblionumber);
754 Return the ISBD view which can be included in opac and intranet
759 my ( $biblionumber, $template ) = @_;
760 my $record = GetMarcBiblio($biblionumber, 1);
761 return undef unless defined $record;
762 my $itemtype = &GetFrameworkCode($biblionumber);
763 my ( $holdingbrtagf, $holdingbrtagsubf ) = &GetMarcFromKohaField( "items.holdingbranch", $itemtype );
764 my $tagslib = &GetMarcStructure( 1, $itemtype );
766 my $ISBD = C4::Context->preference('isbd');
771 foreach my $isbdfield ( split( /#/, $bloc ) ) {
773 # $isbdfield= /(.?.?.?)/;
774 $isbdfield =~ /(\d\d\d)([^\|])?\|(.*)\|(.*)\|(.*)/;
775 my $fieldvalue = $1 || 0;
776 my $subfvalue = $2 || "";
778 my $analysestring = $4;
781 # warn "==> $1 / $2 / $3 / $4";
782 # my $fieldvalue=substr($isbdfield,0,3);
783 if ( $fieldvalue > 0 ) {
784 my $hasputtextbefore = 0;
785 my @fieldslist = $record->field($fieldvalue);
786 @fieldslist = sort { $a->subfield($holdingbrtagsubf) cmp $b->subfield($holdingbrtagsubf) } @fieldslist if ( $fieldvalue eq $holdingbrtagf );
788 # warn "ERROR IN ISBD DEFINITION at : $isbdfield" unless $fieldvalue;
789 # warn "FV : $fieldvalue";
790 if ( $subfvalue ne "" ) {
791 foreach my $field (@fieldslist) {
792 foreach my $subfield ( $field->subfield($subfvalue) ) {
793 my $calculated = $analysestring;
794 my $tag = $field->tag();
797 my $subfieldvalue = GetAuthorisedValueDesc( $tag, $subfvalue, $subfield, '', $tagslib );
798 my $tagsubf = $tag . $subfvalue;
799 $calculated =~ s/\{(.?.?.?.?)$tagsubf(.*?)\}/$1$subfieldvalue$2\{$1$tagsubf$2\}/g;
800 if ( $template eq "opac" ) { $calculated =~ s#/cgi-bin/koha/[^/]+/([^.]*.pl\?.*)$#opac-$1#g; }
802 # field builded, store the result
803 if ( $calculated && !$hasputtextbefore ) { # put textbefore if not done
804 $blocres .= $textbefore;
805 $hasputtextbefore = 1;
808 # remove punctuation at start
809 $calculated =~ s/^( |;|:|\.|-)*//g;
810 $blocres .= $calculated;
815 $blocres .= $textafter if $hasputtextbefore;
817 foreach my $field (@fieldslist) {
818 my $calculated = $analysestring;
819 my $tag = $field->tag();
822 my @subf = $field->subfields;
823 for my $i ( 0 .. $#subf ) {
824 my $valuecode = $subf[$i][1];
825 my $subfieldcode = $subf[$i][0];
826 my $subfieldvalue = GetAuthorisedValueDesc( $tag, $subf[$i][0], $subf[$i][1], '', $tagslib );
827 my $tagsubf = $tag . $subfieldcode;
829 $calculated =~ s/ # replace all {{}} codes by the value code.
830 \{\{$tagsubf\}\} # catch the {{actualcode}}
832 $valuecode # replace by the value code
835 $calculated =~ s/\{(.?.?.?.?)$tagsubf(.*?)\}/$1$subfieldvalue$2\{$1$tagsubf$2\}/g;
836 if ( $template eq "opac" ) { $calculated =~ s#/cgi-bin/koha/[^/]+/([^.]*.pl\?.*)$#opac-$1#g; }
839 # field builded, store the result
840 if ( $calculated && !$hasputtextbefore ) { # put textbefore if not done
841 $blocres .= $textbefore;
842 $hasputtextbefore = 1;
845 # remove punctuation at start
846 $calculated =~ s/^( |;|:|\.|-)*//g;
847 $blocres .= $calculated;
850 $blocres .= $textafter if $hasputtextbefore;
853 $blocres .= $isbdfield;
858 $res =~ s/\{(.*?)\}//g;
860 $res =~ s/\n/<br\/>/g;
870 ( $count, @results ) = &GetBiblio($biblionumber);
875 my ($biblionumber) = @_;
876 my $dbh = C4::Context->dbh;
877 my $sth = $dbh->prepare("SELECT * FROM biblio WHERE biblionumber = ?");
880 $sth->execute($biblionumber);
881 while ( my $data = $sth->fetchrow_hashref ) {
882 $results[$count] = $data;
886 return ( $count, @results );
889 =head2 GetBiblioItemInfosOf
891 GetBiblioItemInfosOf(@biblioitemnumbers);
895 sub GetBiblioItemInfosOf {
896 my @biblioitemnumbers = @_;
899 SELECT biblioitemnumber,
903 WHERE biblioitemnumber IN (' . join( ',', @biblioitemnumbers ) . ')
905 return get_infos_of( $query, 'biblioitemnumber' );
908 =head1 FUNCTIONS FOR HANDLING MARC MANAGEMENT
910 =head2 GetMarcStructure
912 $res = GetMarcStructure($forlibrarian,$frameworkcode);
914 Returns a reference to a big hash of hash, with the Marc structure for the given frameworkcode
915 $forlibrarian :if set to 1, the MARC descriptions are the librarians ones, otherwise it's the public (OPAC) ones
916 $frameworkcode : the framework code to read
920 # cache for results of GetMarcStructure -- needed
922 our $marc_structure_cache;
924 sub GetMarcStructure {
925 my ( $forlibrarian, $frameworkcode ) = @_;
926 my $dbh = C4::Context->dbh;
927 $frameworkcode = "" unless $frameworkcode;
929 if ( defined $marc_structure_cache and exists $marc_structure_cache->{$forlibrarian}->{$frameworkcode} ) {
930 return $marc_structure_cache->{$forlibrarian}->{$frameworkcode};
933 # my $sth = $dbh->prepare(
934 # "SELECT COUNT(*) FROM marc_tag_structure WHERE frameworkcode=?");
935 # $sth->execute($frameworkcode);
936 # my ($total) = $sth->fetchrow;
937 # $frameworkcode = "" unless ( $total > 0 );
938 my $sth = $dbh->prepare(
939 "SELECT tagfield,liblibrarian,libopac,mandatory,repeatable
940 FROM marc_tag_structure
941 WHERE frameworkcode=?
944 $sth->execute($frameworkcode);
945 my ( $liblibrarian, $libopac, $tag, $res, $tab, $mandatory, $repeatable );
947 while ( ( $tag, $liblibrarian, $libopac, $mandatory, $repeatable ) = $sth->fetchrow ) {
948 $res->{$tag}->{lib} = ( $forlibrarian or !$libopac ) ? $liblibrarian : $libopac;
949 $res->{$tag}->{tab} = "";
950 $res->{$tag}->{mandatory} = $mandatory;
951 $res->{$tag}->{repeatable} = $repeatable;
954 $sth = $dbh->prepare(
955 "SELECT tagfield,tagsubfield,liblibrarian,libopac,tab,mandatory,repeatable,authorised_value,authtypecode,value_builder,kohafield,seealso,hidden,isurl,link,defaultvalue
956 FROM marc_subfield_structure
957 WHERE frameworkcode=?
958 ORDER BY tagfield,tagsubfield
962 $sth->execute($frameworkcode);
965 my $authorised_value;
976 ( $tag, $subfield, $liblibrarian, $libopac, $tab, $mandatory, $repeatable, $authorised_value,
977 $authtypecode, $value_builder, $kohafield, $seealso, $hidden, $isurl, $link, $defaultvalue
981 $res->{$tag}->{$subfield}->{lib} = ( $forlibrarian or !$libopac ) ? $liblibrarian : $libopac;
982 $res->{$tag}->{$subfield}->{tab} = $tab;
983 $res->{$tag}->{$subfield}->{mandatory} = $mandatory;
984 $res->{$tag}->{$subfield}->{repeatable} = $repeatable;
985 $res->{$tag}->{$subfield}->{authorised_value} = $authorised_value;
986 $res->{$tag}->{$subfield}->{authtypecode} = $authtypecode;
987 $res->{$tag}->{$subfield}->{value_builder} = $value_builder;
988 $res->{$tag}->{$subfield}->{kohafield} = $kohafield;
989 $res->{$tag}->{$subfield}->{seealso} = $seealso;
990 $res->{$tag}->{$subfield}->{hidden} = $hidden;
991 $res->{$tag}->{$subfield}->{isurl} = $isurl;
992 $res->{$tag}->{$subfield}->{'link'} = $link;
993 $res->{$tag}->{$subfield}->{defaultvalue} = $defaultvalue;
996 $marc_structure_cache->{$forlibrarian}->{$frameworkcode} = $res;
1001 =head2 GetUsedMarcStructure
1003 The same function as GetMarcStructure except it just takes field
1004 in tab 0-9. (used field)
1006 my $results = GetUsedMarcStructure($frameworkcode);
1008 C<$results> is a ref to an array which each case containts a ref
1009 to a hash which each keys is the columns from marc_subfield_structure
1011 C<$frameworkcode> is the framework code.
1015 sub GetUsedMarcStructure($) {
1016 my $frameworkcode = shift || '';
1019 FROM marc_subfield_structure
1021 AND frameworkcode = ?
1022 ORDER BY tagfield, tagsubfield
1024 my $sth = C4::Context->dbh->prepare($query);
1025 $sth->execute($frameworkcode);
1026 return $sth->fetchall_arrayref( {} );
1029 =head2 GetMarcFromKohaField
1031 ($MARCfield,$MARCsubfield)=GetMarcFromKohaField($kohafield,$frameworkcode);
1033 Returns the MARC fields & subfields mapped to the koha field
1034 for the given frameworkcode
1038 sub GetMarcFromKohaField {
1039 my ( $kohafield, $frameworkcode ) = @_;
1040 return (0, undef) unless $kohafield and defined $frameworkcode;
1041 my $relations = C4::Context->marcfromkohafield;
1042 if ( my $mf = $relations->{$frameworkcode}->{$kohafield} ) {
1048 =head2 GetMarcBiblio
1050 my $record = GetMarcBiblio($biblionumber, [$embeditems]);
1052 Returns MARC::Record representing bib identified by
1053 C<$biblionumber>. If no bib exists, returns undef.
1054 C<$embeditems>. If set to true, items data are included.
1055 The MARC record contains biblio data, and items data if $embeditems is set to true.
1060 my $biblionumber = shift;
1061 my $embeditems = shift || 0;
1062 my $dbh = C4::Context->dbh;
1063 my $sth = $dbh->prepare("SELECT marcxml FROM biblioitems WHERE biblionumber=? ");
1064 $sth->execute($biblionumber);
1065 my $row = $sth->fetchrow_hashref;
1066 my $marcxml = StripNonXmlChars( $row->{'marcxml'} );
1067 MARC::File::XML->default_record_format( C4::Context->preference('marcflavour') );
1068 my $record = MARC::Record->new();
1071 $record = eval { MARC::Record::new_from_xml( $marcxml, "utf8", C4::Context->preference('marcflavour') ) };
1072 if ($@) { warn " problem with :$biblionumber : $@ \n$marcxml"; }
1073 return unless $record;
1075 C4::Biblio::_koha_marc_update_bib_ids($record, '', $biblionumber, $biblionumber);
1076 C4::Biblio::EmbedItemsInMarcBiblio($record, $biblionumber) if ($embeditems);
1086 my $marcxml = GetXmlBiblio($biblionumber);
1088 Returns biblioitems.marcxml of the biblionumber passed in parameter.
1089 The XML contains both biblio & item datas
1094 my ($biblionumber) = @_;
1095 my $dbh = C4::Context->dbh;
1096 my $sth = $dbh->prepare("SELECT marcxml FROM biblioitems WHERE biblionumber=? ");
1097 $sth->execute($biblionumber);
1098 my ($marcxml) = $sth->fetchrow;
1102 =head2 GetCOinSBiblio
1104 my $coins = GetCOinSBiblio($record);
1106 Returns the COinS (a span) which can be included in a biblio record
1110 sub GetCOinSBiblio {
1113 # get the coin format
1117 my $pos7 = substr $record->leader(), 7, 1;
1118 my $pos6 = substr $record->leader(), 6, 1;
1121 my ( $aulast, $aufirst ) = ( '', '' );
1130 my $titletype = 'b';
1132 # For the purposes of generating COinS metadata, LDR/06-07 can be
1133 # considered the same for UNIMARC and MARC21
1138 'b' => 'manuscript',
1140 'd' => 'manuscript',
1144 'i' => 'audioRecording',
1145 'j' => 'audioRecording',
1148 'm' => 'computerProgram',
1153 'a' => 'journalArticle',
1157 $genre = $fmts6->{$pos6} ? $fmts6->{$pos6} : 'book';
1159 if ( $genre eq 'book' ) {
1160 $genre = $fmts7->{$pos7} if $fmts7->{$pos7};
1163 ##### We must transform mtx to a valable mtx and document type ####
1164 if ( $genre eq 'book' ) {
1166 } elsif ( $genre eq 'journal' ) {
1169 } elsif ( $genre eq 'journalArticle' ) {
1177 $genre = ( $mtx eq 'dc' ) ? "&rft.type=$genre" : "&rft.genre=$genre";
1179 if ( C4::Context->preference("marcflavour") eq "UNIMARC" ) {
1182 $aulast = $record->subfield( '700', 'a' ) || '';
1183 $aufirst = $record->subfield( '700', 'b' ) || '';
1184 $oauthors = "&rft.au=$aufirst $aulast";
1187 if ( $record->field('200') ) {
1188 for my $au ( $record->field('200')->subfield('g') ) {
1189 $oauthors .= "&rft.au=$au";
1194 ? "&rft.title=" . $record->subfield( '200', 'a' )
1195 : "&rft.title=" . $record->subfield( '200', 'a' ) . "&rft.btitle=" . $record->subfield( '200', 'a' );
1196 $pubyear = $record->subfield( '210', 'd' ) || '';
1197 $publisher = $record->subfield( '210', 'c' ) || '';
1198 $isbn = $record->subfield( '010', 'a' ) || '';
1199 $issn = $record->subfield( '011', 'a' ) || '';
1202 # MARC21 need some improve
1205 if ( $record->field('100') ) {
1206 $oauthors .= "&rft.au=" . $record->subfield( '100', 'a' );
1210 if ( $record->field('700') ) {
1211 for my $au ( $record->field('700')->subfield('a') ) {
1212 $oauthors .= "&rft.au=$au";
1215 $title = "&rft." . $titletype . "title=" . $record->subfield( '245', 'a' );
1216 $subtitle = $record->subfield( '245', 'b' ) || '';
1217 $title .= $subtitle;
1218 if ($titletype eq 'a') {
1219 $pubyear = $record->field('008') || '';
1220 $pubyear = substr($pubyear->data(), 7, 4) if $pubyear;
1221 $isbn = $record->subfield( '773', 'z' ) || '';
1222 $issn = $record->subfield( '773', 'x' ) || '';
1223 if ($mtx eq 'journal') {
1224 $title .= "&rft.title=" . (($record->subfield( '773', 't' ) || $record->subfield( '773', 'a')));
1226 $title .= "&rft.btitle=" . (($record->subfield( '773', 't' ) || $record->subfield( '773', 'a')) || '');
1228 foreach my $rel ($record->subfield( '773', 'g' )) {
1235 $pubyear = $record->subfield( '260', 'c' ) || '';
1236 $publisher = $record->subfield( '260', 'b' ) || '';
1237 $isbn = $record->subfield( '020', 'a' ) || '';
1238 $issn = $record->subfield( '022', 'a' ) || '';
1243 "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";
1244 $coins_value =~ s/(\ |&[^a])/\+/g;
1245 $coins_value =~ s/\"/\"\;/g;
1247 #<!-- 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="
1249 return $coins_value;
1255 return the prices in accordance with the Marc format.
1259 my ( $record, $marcflavour ) = @_;
1263 if ( $marcflavour eq "MARC21" ) {
1264 @listtags = ('345', '020');
1266 } elsif ( $marcflavour eq "UNIMARC" ) {
1267 @listtags = ('345', '010');
1273 for my $field ( $record->field(@listtags) ) {
1274 for my $subfield_value ($field->subfield($subfield)){
1276 return $subfield_value if ($subfield_value);
1279 return 0; # no price found
1282 =head2 GetMarcQuantity
1284 return the quantity of a book. Used in acquisition only, when importing a file an iso2709 from a bookseller
1285 Warning : this is not really in the marc standard. In Unimarc, Electre (the most widely used bookseller) use the 969$a
1289 sub GetMarcQuantity {
1290 my ( $record, $marcflavour ) = @_;
1294 if ( $marcflavour eq "MARC21" ) {
1296 } elsif ( $marcflavour eq "UNIMARC" ) {
1297 @listtags = ('969');
1303 for my $field ( $record->field(@listtags) ) {
1304 for my $subfield_value ($field->subfield($subfield)){
1306 if ($subfield_value) {
1307 # in France, the cents separator is the , but sometimes, ppl use a .
1308 # in this case, the price will be x100 when unformatted ! Replace the . by a , to get a proper price calculation
1309 $subfield_value =~ s/\./,/ if C4::Context->preference("CurrencyFormat") eq "FR";
1310 return $subfield_value;
1314 return 0; # no price found
1318 =head2 GetAuthorisedValueDesc
1320 my $subfieldvalue =get_authorised_value_desc(
1321 $tag, $subf[$i][0],$subf[$i][1], '', $taglib, $category, $opac);
1323 Retrieve the complete description for a given authorised value.
1325 Now takes $category and $value pair too.
1327 my $auth_value_desc =GetAuthorisedValueDesc(
1328 '','', 'DVD' ,'','','CCODE');
1330 If the optional $opac parameter is set to a true value, displays OPAC
1331 descriptions rather than normal ones when they exist.
1335 sub GetAuthorisedValueDesc {
1336 my ( $tag, $subfield, $value, $framework, $tagslib, $category, $opac ) = @_;
1337 my $dbh = C4::Context->dbh;
1341 return $value unless defined $tagslib->{$tag}->{$subfield}->{'authorised_value'};
1344 if ( $tagslib->{$tag}->{$subfield}->{'authorised_value'} eq "branches" ) {
1345 return C4::Branch::GetBranchName($value);
1349 if ( $tagslib->{$tag}->{$subfield}->{'authorised_value'} eq "itemtypes" ) {
1350 return getitemtypeinfo($value)->{description};
1353 #---- "true" authorized value
1354 $category = $tagslib->{$tag}->{$subfield}->{'authorised_value'};
1357 if ( $category ne "" ) {
1358 my $sth = $dbh->prepare( "SELECT lib, lib_opac FROM authorised_values WHERE category = ? AND authorised_value = ?" );
1359 $sth->execute( $category, $value );
1360 my $data = $sth->fetchrow_hashref;
1361 return ( $opac && $data->{'lib_opac'} ) ? $data->{'lib_opac'} : $data->{'lib'};
1363 return $value; # if nothing is found return the original value
1367 =head2 GetMarcControlnumber
1369 $marccontrolnumber = GetMarcControlnumber($record,$marcflavour);
1371 Get the control number / record Identifier from the MARC record and return it.
1375 sub GetMarcControlnumber {
1376 my ( $record, $marcflavour ) = @_;
1377 my $controlnumber = "";
1378 # Control number or Record identifier are the same field in MARC21, UNIMARC and NORMARC
1379 # Keep $marcflavour for possible later use
1380 if ($marcflavour eq "MARC21" || $marcflavour eq "UNIMARC" || $marcflavour eq "NORMARC") {
1381 my $controlnumberField = $record->field('001');
1382 if ($controlnumberField) {
1383 $controlnumber = $controlnumberField->data();
1386 return $controlnumber;
1391 $marcisbnsarray = GetMarcISBN( $record, $marcflavour );
1393 Get all ISBNs from the MARC record and returns them in an array.
1394 ISBNs stored in different fields depending on MARC flavour
1399 my ( $record, $marcflavour ) = @_;
1401 if ( $marcflavour eq "UNIMARC" ) {
1403 } else { # assume marc21 if not unimarc
1410 foreach my $field ( $record->field($scope) ) {
1411 my $value = $field->as_string();
1412 if ( $isbn ne "" ) {
1413 $marcisbn = { marcisbn => $isbn, };
1414 push @marcisbns, $marcisbn;
1417 if ( $isbn ne $value ) {
1418 $isbn = $isbn . " " . $value;
1423 $marcisbn = { marcisbn => $isbn };
1424 push @marcisbns, $marcisbn; #load last tag into array
1432 $marcissnsarray = GetMarcISSN( $record, $marcflavour );
1434 Get all valid ISSNs from the MARC record and returns them in an array.
1435 ISSNs are stored in different fields depending on MARC flavour
1440 my ( $record, $marcflavour ) = @_;
1442 if ( $marcflavour eq "UNIMARC" ) {
1445 else { # assume MARC21 or NORMARC
1449 foreach my $field ( $record->field($scope) ) {
1450 push @marcissns, $field->subfield( 'a' );
1457 $marcnotesarray = GetMarcNotes( $record, $marcflavour );
1459 Get all notes from the MARC record and returns them in an array.
1460 The note are stored in different fields depending on MARC flavour
1465 my ( $record, $marcflavour ) = @_;
1467 if ( $marcflavour eq "UNIMARC" ) {
1469 } else { # assume marc21 if not unimarc
1476 foreach my $field ( $record->field($scope) ) {
1477 my $value = $field->as_string();
1478 if ( $note ne "" ) {
1479 $marcnote = { marcnote => $note, };
1480 push @marcnotes, $marcnote;
1483 if ( $note ne $value ) {
1484 $note = $note . " " . $value;
1489 $marcnote = { marcnote => $note };
1490 push @marcnotes, $marcnote; #load last tag into array
1493 } # end GetMarcNotes
1495 =head2 GetMarcSubjects
1497 $marcsubjcts = GetMarcSubjects($record,$marcflavour);
1499 Get all subjects from the MARC record and returns them in an array.
1500 The subjects are stored in different fields depending on MARC flavour
1504 sub GetMarcSubjects {
1505 my ( $record, $marcflavour ) = @_;
1506 my ( $mintag, $maxtag );
1507 if ( $marcflavour eq "UNIMARC" ) {
1510 } else { # assume marc21 if not unimarc
1520 my $subject_limit = C4::Context->preference("TraceCompleteSubfields") ? 'su,complete-subfield' : 'su';
1522 foreach my $field ( $record->field('6..') ) {
1523 next unless $field->tag() >= $mintag && $field->tag() <= $maxtag;
1525 my @subfields = $field->subfields();
1529 # if there is an authority link, build the link with an= subfield9
1531 for my $subject_subfield (@subfields) {
1533 # don't load unimarc subfields 3,4,5
1534 next if ( ( $marcflavour eq "UNIMARC" ) and ( $subject_subfield->[0] =~ /2|3|4|5/ ) );
1536 # don't load MARC21 subfields 2 (FIXME: any more subfields??)
1537 next if ( ( $marcflavour eq "MARC21" ) and ( $subject_subfield->[0] =~ /2/ ) );
1538 my $code = $subject_subfield->[0];
1539 my $value = $subject_subfield->[1];
1540 my $linkvalue = $value;
1541 $linkvalue =~ s/(\(|\))//g;
1543 if ( $counter != 0 ) {
1544 $operator = ' and ';
1548 @link_loop = ( { 'limit' => 'an', link => "$linkvalue" } );
1550 if ( not $found9 ) {
1551 push @link_loop, { 'limit' => $subject_limit, link => $linkvalue, operator => $operator };
1554 if ( $counter != 0 ) {
1555 $separator = C4::Context->preference('authoritysep');
1559 my @this_link_loop = @link_loop;
1560 push @subfields_loop, { code => $code, value => $value, link_loop => \@this_link_loop, separator => $separator } unless ( $subject_subfield->[0] eq 9 );
1564 push @marcsubjects, { MARCSUBJECT_SUBFIELDS_LOOP => \@subfields_loop };
1567 return \@marcsubjects;
1568 } #end getMARCsubjects
1570 =head2 GetMarcAuthors
1572 authors = GetMarcAuthors($record,$marcflavour);
1574 Get all authors from the MARC record and returns them in an array.
1575 The authors are stored in different fields depending on MARC flavour
1579 sub GetMarcAuthors {
1580 my ( $record, $marcflavour ) = @_;
1581 my ( $mintag, $maxtag );
1583 # tagslib useful for UNIMARC author reponsabilities
1585 &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.
1586 if ( $marcflavour eq "UNIMARC" ) {
1589 } elsif ( $marcflavour eq "MARC21" || $marcflavour eq "NORMARC" ) { # assume marc21 or normarc if not unimarc
1597 foreach my $field ( $record->fields ) {
1598 next unless $field->tag() >= $mintag && $field->tag() <= $maxtag;
1601 my @subfields = $field->subfields();
1604 # if there is an authority link, build the link with Koha-Auth-Number: subfield9
1605 my $subfield9 = $field->subfield('9');
1606 for my $authors_subfield (@subfields) {
1608 # don't load unimarc subfields 3, 5
1609 next if ( $marcflavour eq 'UNIMARC' and ( $authors_subfield->[0] =~ /3|5/ ) );
1610 my $subfieldcode = $authors_subfield->[0];
1611 my $value = $authors_subfield->[1];
1612 my $linkvalue = $value;
1613 $linkvalue =~ s/(\(|\))//g;
1615 if ( $count_auth != 0 ) {
1616 $operator = ' and ';
1619 # if we have an authority link, use that as the link, otherwise use standard searching
1621 @link_loop = ( { 'limit' => 'an', link => "$subfield9" } );
1624 # reset $linkvalue if UNIMARC author responsibility
1625 if ( $marcflavour eq 'UNIMARC' and ( $authors_subfield->[0] eq "4" ) ) {
1626 $linkvalue = "(" . GetAuthorisedValueDesc( $field->tag(), $authors_subfield->[0], $authors_subfield->[1], '', $tagslib ) . ")";
1628 push @link_loop, { 'limit' => 'au', link => $linkvalue, operator => $operator };
1630 $value = GetAuthorisedValueDesc( $field->tag(), $authors_subfield->[0], $authors_subfield->[1], '', $tagslib )
1631 if ( $marcflavour eq 'UNIMARC' and ( $authors_subfield->[0] =~ /4/ ) );
1632 my @this_link_loop = @link_loop;
1634 if ( $count_auth != 0 ) {
1635 $separator = C4::Context->preference('authoritysep');
1637 push @subfields_loop,
1638 { tag => $field->tag(),
1639 code => $subfieldcode,
1641 link_loop => \@this_link_loop,
1642 separator => $separator
1644 unless ( $authors_subfield->[0] eq '9' );
1647 push @marcauthors, { MARCAUTHOR_SUBFIELDS_LOOP => \@subfields_loop };
1649 return \@marcauthors;
1654 $marcurls = GetMarcUrls($record,$marcflavour);
1656 Returns arrayref of URLs from MARC data, suitable to pass to tmpl loop.
1657 Assumes web resources (not uncommon in MARC21 to omit resource type ind)
1662 my ( $record, $marcflavour ) = @_;
1665 for my $field ( $record->field('856') ) {
1667 for my $note ( $field->subfield('z') ) {
1668 push @notes, { note => $note };
1670 my @urls = $field->subfield('u');
1671 foreach my $url (@urls) {
1673 if ( $marcflavour eq 'MARC21' ) {
1674 my $s3 = $field->subfield('3');
1675 my $link = $field->subfield('y');
1676 unless ( $url =~ /^\w+:/ ) {
1677 if ( $field->indicator(1) eq '7' ) {
1678 $url = $field->subfield('2') . "://" . $url;
1679 } elsif ( $field->indicator(1) eq '1' ) {
1680 $url = 'ftp://' . $url;
1683 # properly, this should be if ind1=4,
1684 # however we will assume http protocol since we're building a link.
1685 $url = 'http://' . $url;
1689 # TODO handle ind 2 (relationship)
1694 $marcurl->{'linktext'} = $link || $s3 || C4::Context->preference('URLLinkText') || $url;
1695 $marcurl->{'part'} = $s3 if ($link);
1696 $marcurl->{'toc'} = 1 if ( defined($s3) && $s3 =~ /^[Tt]able/ );
1698 $marcurl->{'linktext'} = $field->subfield('2') || C4::Context->preference('URLLinkText') || $url;
1699 $marcurl->{'MARCURL'} = $url;
1701 push @marcurls, $marcurl;
1707 =head2 GetMarcSeries
1709 $marcseriesarray = GetMarcSeries($record,$marcflavour);
1711 Get all series from the MARC record and returns them in an array.
1712 The series are stored in different fields depending on MARC flavour
1717 my ( $record, $marcflavour ) = @_;
1718 my ( $mintag, $maxtag );
1719 if ( $marcflavour eq "UNIMARC" ) {
1722 } else { # assume marc21 if not unimarc
1732 foreach my $field ( $record->field('440'), $record->field('490') ) {
1735 #my $value = $field->subfield('a');
1736 #$marcsubjct = {MARCSUBJCT => $value,};
1737 my @subfields = $field->subfields();
1739 #warn "subfields:".join " ", @$subfields;
1742 for my $series_subfield (@subfields) {
1744 undef $volume_number;
1746 # see if this is an instance of a volume
1747 if ( $series_subfield->[0] eq 'v' ) {
1751 my $code = $series_subfield->[0];
1752 my $value = $series_subfield->[1];
1753 my $linkvalue = $value;
1754 $linkvalue =~ s/(\(|\))//g;
1755 if ( $counter != 0 ) {
1756 push @link_loop, { link => $linkvalue, operator => ' and ', };
1758 push @link_loop, { link => $linkvalue, operator => undef, };
1761 if ( $counter != 0 ) {
1762 $separator = C4::Context->preference('authoritysep');
1764 if ($volume_number) {
1765 push @subfields_loop, { volumenum => $value };
1767 if ( $series_subfield->[0] ne '9' ) {
1768 push @subfields_loop, {
1771 link_loop => \@link_loop,
1772 separator => $separator,
1773 volumenum => $volume_number,
1779 push @marcseries, { MARCSERIES_SUBFIELDS_LOOP => \@subfields_loop };
1781 #$marcsubjct = {MARCSUBJCT => $field->as_string(),};
1782 #push @marcsubjcts, $marcsubjct;
1786 my $marcseriessarray = \@marcseries;
1787 return $marcseriessarray;
1788 } #end getMARCseriess
1792 $marchostsarray = GetMarcHosts($record,$marcflavour);
1794 Get all host records (773s MARC21, 461 UNIMARC) from the MARC record and returns them in an array.
1799 my ( $record, $marcflavour ) = @_;
1800 my ( $tag,$title_subf,$bibnumber_subf,$itemnumber_subf);
1801 $marcflavour ||="MARC21";
1802 if ( $marcflavour eq "MARC21" || $marcflavour eq "NORMARC" ) {
1805 $bibnumber_subf ="0";
1806 $itemnumber_subf='9';
1808 elsif ($marcflavour eq "UNIMARC") {
1811 $bibnumber_subf ="0";
1812 $itemnumber_subf='9';
1817 foreach my $field ( $record->field($tag)) {
1821 my $hostbiblionumber = $field->subfield("$bibnumber_subf");
1822 my $hosttitle = $field->subfield($title_subf);
1823 my $hostitemnumber=$field->subfield($itemnumber_subf);
1824 push @fields_loop, { hostbiblionumber => $hostbiblionumber, hosttitle => $hosttitle, hostitemnumber => $hostitemnumber};
1825 push @marchosts, { MARCHOSTS_FIELDS_LOOP => \@fields_loop };
1828 my $marchostsarray = \@marchosts;
1829 return $marchostsarray;
1832 =head2 GetFrameworkCode
1834 $frameworkcode = GetFrameworkCode( $biblionumber )
1838 sub GetFrameworkCode {
1839 my ($biblionumber) = @_;
1840 my $dbh = C4::Context->dbh;
1841 my $sth = $dbh->prepare("SELECT frameworkcode FROM biblio WHERE biblionumber=?");
1842 $sth->execute($biblionumber);
1843 my ($frameworkcode) = $sth->fetchrow;
1844 return $frameworkcode;
1847 =head2 TransformKohaToMarc
1849 $record = TransformKohaToMarc( $hash )
1851 This function builds partial MARC::Record from a hash
1852 Hash entries can be from biblio or biblioitems.
1854 This function is called in acquisition module, to create a basic catalogue
1855 entry from user entry
1860 sub TransformKohaToMarc {
1862 my $record = MARC::Record->new();
1863 SetMarcUnicodeFlag( $record, C4::Context->preference("marcflavour") );
1864 my $db_to_marc = C4::Context->marcfromkohafield;
1865 while ( my ($name, $value) = each %$hash ) {
1866 next unless my $dtm = $db_to_marc->{''}->{$name};
1867 my ($tag, $letter) = @$dtm;
1868 foreach my $value ( split(/\s?\|\s?/, $value, -1) ) {
1869 if ( my $field = $record->field($tag) ) {
1870 $field->add_subfields( $letter => $value );
1873 $record->insert_fields_ordered( MARC::Field->new(
1874 $tag, " ", " ", $letter => $value ) );
1882 =head2 PrepHostMarcField
1884 $hostfield = PrepHostMarcField ( $hostbiblionumber,$hostitemnumber,$marcflavour )
1886 This function returns a host field populated with data from the host record, the field can then be added to an analytical record
1890 sub PrepHostMarcField {
1891 my ($hostbiblionumber,$hostitemnumber, $marcflavour) = @_;
1892 $marcflavour ||="MARC21";
1894 my $hostrecord = GetMarcBiblio($hostbiblionumber);
1895 my $item = C4::Items::GetItem($hostitemnumber);
1898 if ( $marcflavour eq "MARC21" || $marcflavour eq "NORMARC" ) {
1902 if ($hostrecord->subfield('100','a')){
1903 $mainentry = $hostrecord->subfield('100','a');
1904 } elsif ($hostrecord->subfield('110','a')){
1905 $mainentry = $hostrecord->subfield('110','a');
1907 $mainentry = $hostrecord->subfield('111','a');
1910 # qualification info
1912 if (my $field260 = $hostrecord->field('260')){
1913 $qualinfo = $field260->as_string( 'abc' );
1918 my $ed = $hostrecord->subfield('250','a');
1919 my $barcode = $item->{'barcode'};
1920 my $title = $hostrecord->subfield('245','a');
1922 # record control number, 001 with 003 and prefix
1924 if ($hostrecord->field('001')){
1925 $recctrlno = $hostrecord->field('001')->data();
1926 if ($hostrecord->field('003')){
1927 $recctrlno = '('.$hostrecord->field('003')->data().')'.$recctrlno;
1932 my $issn = $hostrecord->subfield('022','a');
1933 my $isbn = $hostrecord->subfield('020','a');
1936 $hostmarcfield = MARC::Field->new(
1938 '0' => $hostbiblionumber,
1939 '9' => $hostitemnumber,
1949 } elsif ($marcflavour eq "UNIMARC") {
1950 $hostmarcfield = MARC::Field->new(
1952 '0' => $hostbiblionumber,
1953 't' => $hostrecord->subfield('200','a'),
1954 '9' => $hostitemnumber
1958 return $hostmarcfield;
1961 =head2 TransformHtmlToXml
1963 $xml = TransformHtmlToXml( $tags, $subfields, $values, $indicator,
1964 $ind_tag, $auth_type )
1966 $auth_type contains :
1970 =item - nothing : rebuild a biblio. In UNIMARC the encoding is in 100$a pos 26/27
1972 =item - UNIMARCAUTH : rebuild an authority. In UNIMARC, the encoding is in 100$a pos 13/14
1974 =item - ITEM : rebuild an item : in UNIMARC, 100$a, it's in the biblio ! (otherwise, we would get 2 100 fields !)
1980 sub TransformHtmlToXml {
1981 my ( $tags, $subfields, $values, $indicator, $ind_tag, $auth_type ) = @_;
1982 my $xml = MARC::File::XML::header('UTF-8');
1983 $xml .= "<record>\n";
1984 $auth_type = C4::Context->preference('marcflavour') unless $auth_type;
1985 MARC::File::XML->default_record_format($auth_type);
1987 # in UNIMARC, field 100 contains the encoding
1988 # check that there is one, otherwise the
1989 # MARC::Record->new_from_xml will fail (and Koha will die)
1990 my $unimarc_and_100_exist = 0;
1991 $unimarc_and_100_exist = 1 if $auth_type eq 'ITEM'; # if we rebuild an item, no need of a 100 field
1996 for ( my $i = 0 ; $i < @$tags ; $i++ ) {
1998 if ( C4::Context->preference('marcflavour') eq 'UNIMARC' and @$tags[$i] eq "100" and @$subfields[$i] eq "a" ) {
2000 # if we have a 100 field and it's values are not correct, skip them.
2001 # if we don't have any valid 100 field, we will create a default one at the end
2002 my $enc = substr( @$values[$i], 26, 2 );
2003 if ( $enc eq '01' or $enc eq '50' or $enc eq '03' ) {
2004 $unimarc_and_100_exist = 1;
2009 @$values[$i] =~ s/&/&/g;
2010 @$values[$i] =~ s/</</g;
2011 @$values[$i] =~ s/>/>/g;
2012 @$values[$i] =~ s/"/"/g;
2013 @$values[$i] =~ s/'/'/g;
2015 # if ( !utf8::is_utf8( @$values[$i] ) ) {
2016 # utf8::decode( @$values[$i] );
2018 if ( ( @$tags[$i] ne $prevtag ) ) {
2019 $j++ unless ( @$tags[$i] eq "" );
2020 my $indicator1 = eval { substr( @$indicator[$j], 0, 1 ) };
2021 my $indicator2 = eval { substr( @$indicator[$j], 1, 1 ) };
2022 my $ind1 = _default_ind_to_space($indicator1);
2024 if ( @$indicator[$j] ) {
2025 $ind2 = _default_ind_to_space($indicator2);
2027 warn "Indicator in @$tags[$i] is empty";
2031 $xml .= "</datafield>\n";
2032 if ( ( @$tags[$i] && @$tags[$i] > 10 )
2033 && ( @$values[$i] ne "" ) ) {
2034 $xml .= "<datafield tag=\"@$tags[$i]\" ind1=\"$ind1\" ind2=\"$ind2\">\n";
2035 $xml .= "<subfield code=\"@$subfields[$i]\">@$values[$i]</subfield>\n";
2041 if ( @$values[$i] ne "" ) {
2044 if ( @$tags[$i] eq "000" ) {
2045 $xml .= "<leader>@$values[$i]</leader>\n";
2048 # rest of the fixed fields
2049 } elsif ( @$tags[$i] < 10 ) {
2050 $xml .= "<controlfield tag=\"@$tags[$i]\">@$values[$i]</controlfield>\n";
2053 $xml .= "<datafield tag=\"@$tags[$i]\" ind1=\"$ind1\" ind2=\"$ind2\">\n";
2054 $xml .= "<subfield code=\"@$subfields[$i]\">@$values[$i]</subfield>\n";
2059 } else { # @$tags[$i] eq $prevtag
2060 my $indicator1 = eval { substr( @$indicator[$j], 0, 1 ) };
2061 my $indicator2 = eval { substr( @$indicator[$j], 1, 1 ) };
2062 my $ind1 = _default_ind_to_space($indicator1);
2064 if ( @$indicator[$j] ) {
2065 $ind2 = _default_ind_to_space($indicator2);
2067 warn "Indicator in @$tags[$i] is empty";
2070 if ( @$values[$i] eq "" ) {
2073 $xml .= "<datafield tag=\"@$tags[$i]\" ind1=\"$ind1\" ind2=\"$ind2\">\n";
2076 $xml .= "<subfield code=\"@$subfields[$i]\">@$values[$i]</subfield>\n";
2079 $prevtag = @$tags[$i];
2081 $xml .= "</datafield>\n" if $xml =~ m/<datafield/;
2082 if ( C4::Context->preference('marcflavour') eq 'UNIMARC' and !$unimarc_and_100_exist ) {
2084 # warn "SETTING 100 for $auth_type";
2085 my $string = strftime( "%Y%m%d", localtime(time) );
2087 # set 50 to position 26 is biblios, 13 if authorities
2089 $pos = 13 if $auth_type eq 'UNIMARCAUTH';
2090 $string = sprintf( "%-*s", 35, $string );
2091 substr( $string, $pos, 6, "50" );
2092 $xml .= "<datafield tag=\"100\" ind1=\"\" ind2=\"\">\n";
2093 $xml .= "<subfield code=\"a\">$string</subfield>\n";
2094 $xml .= "</datafield>\n";
2096 $xml .= "</record>\n";
2097 $xml .= MARC::File::XML::footer();
2101 =head2 _default_ind_to_space
2103 Passed what should be an indicator returns a space
2104 if its undefined or zero length
2108 sub _default_ind_to_space {
2110 if ( !defined $s || $s eq q{} ) {
2116 =head2 TransformHtmlToMarc
2118 L<$record> = TransformHtmlToMarc(L<$cgi>)
2119 L<$cgi> is the CGI object which containts the values for subfields
2121 'tag_010_indicator1_531951' ,
2122 'tag_010_indicator2_531951' ,
2123 'tag_010_code_a_531951_145735' ,
2124 'tag_010_subfield_a_531951_145735' ,
2125 'tag_200_indicator1_873510' ,
2126 'tag_200_indicator2_873510' ,
2127 'tag_200_code_a_873510_673465' ,
2128 'tag_200_subfield_a_873510_673465' ,
2129 'tag_200_code_b_873510_704318' ,
2130 'tag_200_subfield_b_873510_704318' ,
2131 'tag_200_code_e_873510_280822' ,
2132 'tag_200_subfield_e_873510_280822' ,
2133 'tag_200_code_f_873510_110730' ,
2134 'tag_200_subfield_f_873510_110730' ,
2136 L<$record> is the MARC::Record object.
2140 sub TransformHtmlToMarc {
2143 my @params = $cgi->param();
2145 # explicitly turn on the UTF-8 flag for all
2146 # 'tag_' parameters to avoid incorrect character
2147 # conversion later on
2148 my $cgi_params = $cgi->Vars;
2149 foreach my $param_name ( keys %$cgi_params ) {
2150 if ( $param_name =~ /^tag_/ ) {
2151 my $param_value = $cgi_params->{$param_name};
2152 if ( utf8::decode($param_value) ) {
2153 $cgi_params->{$param_name} = $param_value;
2156 # FIXME - need to do something if string is not valid UTF-8
2160 # creating a new record
2161 my $record = MARC::Record->new();
2164 #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!
2165 while ( $params[$i] ) { # browse all CGI params
2166 my $param = $params[$i];
2169 # if we are on biblionumber, store it in the MARC::Record (it may not be in the edited fields)
2170 if ( $param eq 'biblionumber' ) {
2171 my ( $biblionumbertagfield, $biblionumbertagsubfield ) = &GetMarcFromKohaField( "biblio.biblionumber", '' );
2172 if ( $biblionumbertagfield < 10 ) {
2173 $newfield = MARC::Field->new( $biblionumbertagfield, $cgi->param($param), );
2175 $newfield = MARC::Field->new( $biblionumbertagfield, '', '', "$biblionumbertagsubfield" => $cgi->param($param), );
2177 push @fields, $newfield if ($newfield);
2178 } elsif ( $param =~ /^tag_(\d*)_indicator1_/ ) { # new field start when having 'input name="..._indicator1_..."
2181 my $ind1 = _default_ind_to_space( substr( $cgi->param($param), 0, 1 ) );
2182 my $ind2 = _default_ind_to_space( substr( $cgi->param( $params[ $i + 1 ] ), 0, 1 ) );
2186 if ( $tag < 10 ) { # no code for theses fields
2187 # in MARC editor, 000 contains the leader.
2188 if ( $tag eq '000' ) {
2189 # Force a fake leader even if not provided to avoid crashing
2190 # during decoding MARC record containing UTF-8 characters
2192 length( $cgi->param($params[$j+1]) ) == 24
2193 ? $cgi->param( $params[ $j + 1 ] )
2197 # between 001 and 009 (included)
2198 } elsif ( $cgi->param( $params[ $j + 1 ] ) ne '' ) {
2199 $newfield = MARC::Field->new( $tag, $cgi->param( $params[ $j + 1 ] ), );
2202 # > 009, deal with subfields
2204 # browse subfields for this tag (reason for _code_ match)
2205 while(defined $params[$j] && $params[$j] =~ /_code_/) {
2206 last unless defined $params[$j+1];
2207 #if next param ne subfield, then it was probably empty
2208 #try next param by incrementing j
2209 if($params[$j+1]!~/_subfield_/) {$j++; next; }
2210 my $fval= $cgi->param($params[$j+1]);
2211 #check if subfield value not empty and field exists
2212 if($fval ne '' && $newfield) {
2213 $newfield->add_subfields( $cgi->param($params[$j]) => $fval);
2215 elsif($fval ne '') {
2216 $newfield = MARC::Field->new( $tag, $ind1, $ind2, $cgi->param($params[$j]) => $fval );
2220 $i= $j-1; #update i for outer loop accordingly
2222 push @fields, $newfield if ($newfield);
2227 $record->append_fields(@fields);
2231 # cache inverted MARC field map
2232 our $inverted_field_map;
2234 =head2 TransformMarcToKoha
2236 $result = TransformMarcToKoha( $dbh, $record, $frameworkcode )
2238 Extract data from a MARC bib record into a hashref representing
2239 Koha biblio, biblioitems, and items fields.
2243 sub TransformMarcToKoha {
2244 my ( $dbh, $record, $frameworkcode, $limit_table ) = @_;
2247 $limit_table = $limit_table || 0;
2248 $frameworkcode = '' unless defined $frameworkcode;
2250 unless ( defined $inverted_field_map ) {
2251 $inverted_field_map = _get_inverted_marc_field_map();
2255 if ( defined $limit_table && $limit_table eq 'items' ) {
2256 $tables{'items'} = 1;
2258 $tables{'items'} = 1;
2259 $tables{'biblio'} = 1;
2260 $tables{'biblioitems'} = 1;
2263 # traverse through record
2264 MARCFIELD: foreach my $field ( $record->fields() ) {
2265 my $tag = $field->tag();
2266 next MARCFIELD unless exists $inverted_field_map->{$frameworkcode}->{$tag};
2267 if ( $field->is_control_field() ) {
2268 my $kohafields = $inverted_field_map->{$frameworkcode}->{$tag}->{list};
2269 ENTRY: foreach my $entry ( @{$kohafields} ) {
2270 my ( $subfield, $table, $column ) = @{$entry};
2271 next ENTRY unless exists $tables{$table};
2272 my $key = _disambiguate( $table, $column );
2273 if ( $result->{$key} ) {
2274 unless ( ( $key eq "biblionumber" or $key eq "biblioitemnumber" ) and ( $field->data() eq "" ) ) {
2275 $result->{$key} .= " | " . $field->data();
2278 $result->{$key} = $field->data();
2283 # deal with subfields
2284 MARCSUBFIELD: foreach my $sf ( $field->subfields() ) {
2285 my $code = $sf->[0];
2286 next MARCSUBFIELD unless exists $inverted_field_map->{$frameworkcode}->{$tag}->{sfs}->{$code};
2287 my $value = $sf->[1];
2288 SFENTRY: foreach my $entry ( @{ $inverted_field_map->{$frameworkcode}->{$tag}->{sfs}->{$code} } ) {
2289 my ( $table, $column ) = @{$entry};
2290 next SFENTRY unless exists $tables{$table};
2291 my $key = _disambiguate( $table, $column );
2292 if ( $result->{$key} ) {
2293 unless ( ( $key eq "biblionumber" or $key eq "biblioitemnumber" ) and ( $value eq "" ) ) {
2294 $result->{$key} .= " | " . $value;
2297 $result->{$key} = $value;
2304 # modify copyrightdate to keep only the 1st year found
2305 if ( exists $result->{'copyrightdate'} ) {
2306 my $temp = $result->{'copyrightdate'};
2307 $temp =~ m/c(\d\d\d\d)/;
2308 if ( $temp =~ m/c(\d\d\d\d)/ and $1 > 0 ) { # search cYYYY first
2309 $result->{'copyrightdate'} = $1;
2310 } else { # if no cYYYY, get the 1st date.
2311 $temp =~ m/(\d\d\d\d)/;
2312 $result->{'copyrightdate'} = $1;
2316 # modify publicationyear to keep only the 1st year found
2317 if ( exists $result->{'publicationyear'} ) {
2318 my $temp = $result->{'publicationyear'};
2319 if ( $temp =~ m/c(\d\d\d\d)/ and $1 > 0 ) { # search cYYYY first
2320 $result->{'publicationyear'} = $1;
2321 } else { # if no cYYYY, get the 1st date.
2322 $temp =~ m/(\d\d\d\d)/;
2323 $result->{'publicationyear'} = $1;
2330 sub _get_inverted_marc_field_map {
2332 my $relations = C4::Context->marcfromkohafield;
2334 foreach my $frameworkcode ( keys %{$relations} ) {
2335 foreach my $kohafield ( keys %{ $relations->{$frameworkcode} } ) {
2336 next unless @{ $relations->{$frameworkcode}->{$kohafield} }; # not all columns are mapped to MARC tag & subfield
2337 my $tag = $relations->{$frameworkcode}->{$kohafield}->[0];
2338 my $subfield = $relations->{$frameworkcode}->{$kohafield}->[1];
2339 my ( $table, $column ) = split /[.]/, $kohafield, 2;
2340 push @{ $field_map->{$frameworkcode}->{$tag}->{list} }, [ $subfield, $table, $column ];
2341 push @{ $field_map->{$frameworkcode}->{$tag}->{sfs}->{$subfield} }, [ $table, $column ];
2347 =head2 _disambiguate
2349 $newkey = _disambiguate($table, $field);
2351 This is a temporary hack to distinguish between the
2352 following sets of columns when using TransformMarcToKoha.
2354 items.cn_source & biblioitems.cn_source
2355 items.cn_sort & biblioitems.cn_sort
2357 Columns that are currently NOT distinguished (FIXME
2358 due to lack of time to fully test) are:
2360 biblio.notes and biblioitems.notes
2365 FIXME - this is necessary because prefixing each column
2366 name with the table name would require changing lots
2367 of code and templates, and exposing more of the DB
2368 structure than is good to the UI templates, particularly
2369 since biblio and bibloitems may well merge in a future
2370 version. In the future, it would also be good to
2371 separate DB access and UI presentation field names
2376 sub CountItemsIssued {
2377 my ($biblionumber) = @_;
2378 my $dbh = C4::Context->dbh;
2379 my $sth = $dbh->prepare('SELECT COUNT(*) as issuedCount FROM items, issues WHERE items.itemnumber = issues.itemnumber AND items.biblionumber = ?');
2380 $sth->execute($biblionumber);
2381 my $row = $sth->fetchrow_hashref();
2382 return $row->{'issuedCount'};
2386 my ( $table, $column ) = @_;
2387 if ( $column eq "cn_sort" or $column eq "cn_source" ) {
2388 return $table . '.' . $column;
2395 =head2 get_koha_field_from_marc
2397 $result->{_disambiguate($table, $field)} =
2398 get_koha_field_from_marc($table,$field,$record,$frameworkcode);
2400 Internal function to map data from the MARC record to a specific non-MARC field.
2401 FIXME: this is meant to replace TransformMarcToKohaOneField after more testing.
2405 sub get_koha_field_from_marc {
2406 my ( $koha_table, $koha_column, $record, $frameworkcode ) = @_;
2407 my ( $tagfield, $subfield ) = GetMarcFromKohaField( $koha_table . '.' . $koha_column, $frameworkcode );
2409 foreach my $field ( $record->field($tagfield) ) {
2410 if ( $field->tag() < 10 ) {
2412 $kohafield .= " | " . $field->data();
2414 $kohafield = $field->data();
2417 if ( $field->subfields ) {
2418 my @subfields = $field->subfields();
2419 foreach my $subfieldcount ( 0 .. $#subfields ) {
2420 if ( $subfields[$subfieldcount][0] eq $subfield ) {
2422 $kohafield .= " | " . $subfields[$subfieldcount][1];
2424 $kohafield = $subfields[$subfieldcount][1];
2434 =head2 TransformMarcToKohaOneField
2436 $result = TransformMarcToKohaOneField( $kohatable, $kohafield, $record, $result, $frameworkcode )
2440 sub TransformMarcToKohaOneField {
2442 # FIXME ? if a field has a repeatable subfield that is used in old-db,
2443 # only the 1st will be retrieved...
2444 my ( $kohatable, $kohafield, $record, $result, $frameworkcode ) = @_;
2446 my ( $tagfield, $subfield ) = GetMarcFromKohaField( $kohatable . "." . $kohafield, $frameworkcode );
2447 foreach my $field ( $record->field($tagfield) ) {
2448 if ( $field->tag() < 10 ) {
2449 if ( $result->{$kohafield} ) {
2450 $result->{$kohafield} .= " | " . $field->data();
2452 $result->{$kohafield} = $field->data();
2455 if ( $field->subfields ) {
2456 my @subfields = $field->subfields();
2457 foreach my $subfieldcount ( 0 .. $#subfields ) {
2458 if ( $subfields[$subfieldcount][0] eq $subfield ) {
2459 if ( $result->{$kohafield} ) {
2460 $result->{$kohafield} .= " | " . $subfields[$subfieldcount][1];
2462 $result->{$kohafield} = $subfields[$subfieldcount][1];
2476 # true ModZebra commented until indexdata fixes zebraDB crashes (it seems they occur on multiple updates
2478 # replaced by a zebraqueue table, that is filled with ModZebra to run.
2479 # the table is emptied by misc/cronjobs/zebraqueue_start.pl script
2480 # =head2 ModZebrafiles
2482 # &ModZebrafiles( $dbh, $biblionumber, $record, $folder, $server );
2486 # sub ModZebrafiles {
2488 # my ( $dbh, $biblionumber, $record, $folder, $server ) = @_;
2492 # C4::Context->zebraconfig($server)->{directory} . "/" . $folder . "/";
2493 # unless ( opendir( DIR, "$zebradir" ) ) {
2494 # warn "$zebradir not found";
2498 # my $filename = $zebradir . $biblionumber;
2501 # open( OUTPUT, ">", $filename . ".xml" );
2502 # print OUTPUT $record;
2509 ModZebra( $biblionumber, $op, $server, $oldRecord, $newRecord );
2511 $biblionumber is the biblionumber we want to index
2513 $op is specialUpdate or delete, and is used to know what we want to do
2515 $server is the server that we want to update
2517 $oldRecord is the MARC::Record containing the previous version of the record. This is used only when
2518 NoZebra=1, as NoZebra indexing needs to know the previous version of a record in order to
2521 $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.
2526 ###Accepts a $server variable thus we can use it for biblios authorities or other zebra dbs
2527 my ( $biblionumber, $op, $server, $oldRecord, $newRecord ) = @_;
2528 my $dbh = C4::Context->dbh;
2530 # true ModZebra commented until indexdata fixes zebraDB crashes (it seems they occur on multiple updates
2532 # replaced by a zebraqueue table, that is filled with ModZebra to run.
2533 # the table is emptied by misc/cronjobs/zebraqueue_start.pl script
2535 if ( C4::Context->preference("NoZebra") ) {
2537 # lock the nozebra table : we will read index lines, update them in Perl process
2538 # and write everything in 1 transaction.
2539 # lock the table to avoid someone else overwriting what we are doing
2540 $dbh->do('LOCK TABLES nozebra WRITE,biblio WRITE,biblioitems WRITE, systempreferences WRITE, auth_types WRITE, auth_header WRITE, auth_subfield_structure READ');
2541 my %result; # the result hash that will be built by deletion / add, and written on mySQL at the end, to improve speed
2542 if ( $op eq 'specialUpdate' ) {
2544 # OK, we have to add or update the record
2545 # 1st delete (virtually, in indexes), if record actually exists
2547 %result = _DelBiblioNoZebra( $biblionumber, $oldRecord, $server );
2550 # ... add the record
2551 %result = _AddBiblioNoZebra( $biblionumber, $newRecord, $server, %result );
2554 # it's a deletion, delete the record...
2555 # warn "DELETE the record $biblionumber on $server".$record->as_formatted;
2556 %result = _DelBiblioNoZebra( $biblionumber, $oldRecord, $server );
2559 # ok, now update the database...
2560 my $sth = $dbh->prepare("UPDATE nozebra SET biblionumbers=? WHERE server=? AND indexname=? AND value=?");
2561 foreach my $key ( keys %result ) {
2562 foreach my $index ( keys %{ $result{$key} } ) {
2563 $sth->execute( $result{$key}->{$index}, $server, $key, $index );
2566 $dbh->do('UNLOCK TABLES');
2570 # we use zebra, just fill zebraqueue table
2572 my $check_sql = "SELECT COUNT(*) FROM zebraqueue
2574 AND biblio_auth_number = ?
2577 my $check_sth = $dbh->prepare_cached($check_sql);
2578 $check_sth->execute( $server, $biblionumber, $op );
2579 my ($count) = $check_sth->fetchrow_array;
2580 $check_sth->finish();
2581 if ( $count == 0 ) {
2582 my $sth = $dbh->prepare("INSERT INTO zebraqueue (biblio_auth_number,server,operation) VALUES(?,?,?)");
2583 $sth->execute( $biblionumber, $server, $op );
2589 =head2 GetNoZebraIndexes
2591 %indexes = GetNoZebraIndexes;
2593 return the data from NoZebraIndexes syspref.
2597 sub GetNoZebraIndexes {
2598 my $no_zebra_indexes = C4::Context->preference('NoZebraIndexes');
2600 INDEX: foreach my $line ( split /['"],[\n\r]*/, $no_zebra_indexes ) {
2601 $line =~ /(.*)=>(.*)/;
2602 my $index = $1; # initial ' or " is removed afterwards
2604 $index =~ s/'|"|\s//g;
2605 $fields =~ s/'|"|\s//g;
2606 $indexes{$index} = $fields;
2611 =head2 EmbedItemsInMarcBiblio
2613 EmbedItemsInMarcBiblio($marc, $biblionumber);
2615 Given a MARC::Record object containing a bib record,
2616 modify it to include the items attached to it as 9XX
2617 per the bib's MARC framework.
2621 sub EmbedItemsInMarcBiblio {
2622 my ($marc, $biblionumber) = @_;
2623 croak "No MARC record" unless $marc;
2625 my $frameworkcode = GetFrameworkCode($biblionumber);
2626 _strip_item_fields($marc, $frameworkcode);
2628 # ... and embed the current items
2629 my $dbh = C4::Context->dbh;
2630 my $sth = $dbh->prepare("SELECT itemnumber FROM items WHERE biblionumber = ?");
2631 $sth->execute($biblionumber);
2633 my ( $itemtag, $itemsubfield ) = GetMarcFromKohaField( "items.itemnumber", $frameworkcode );
2634 while (my ($itemnumber) = $sth->fetchrow_array) {
2636 my $item_marc = C4::Items::GetMarcItem($biblionumber, $itemnumber);
2637 push @item_fields, $item_marc->field($itemtag);
2639 $marc->append_fields(@item_fields);
2642 =head1 INTERNAL FUNCTIONS
2644 =head2 _DelBiblioNoZebra($biblionumber,$record,$server);
2646 function to delete a biblio in NoZebra indexes
2647 This function does NOT delete anything in database : it reads all the indexes entries
2648 that have to be deleted & delete them in the hash
2650 The SQL part is done either :
2651 - after the Add if we are modifying a biblio (delete + add again)
2652 - immediatly after this sub if we are doing a true deletion.
2654 $server can be 'biblioserver' or 'authorityserver' : it indexes biblios or authorities (in the same table, $server being part of the table itself
2658 sub _DelBiblioNoZebra {
2659 my ( $biblionumber, $record, $server ) = @_;
2662 my $dbh = C4::Context->dbh;
2667 if ( $server eq 'biblioserver' ) {
2668 %index = GetNoZebraIndexes;
2670 # get title of the record (to store the 10 first letters with the index)
2671 my ( $titletag, $titlesubfield ) = GetMarcFromKohaField( 'biblio.title', '' ); # FIXME: should be GetFrameworkCode($biblionumber) ??
2672 $title = lc( $record->subfield( $titletag, $titlesubfield ) );
2675 # for authorities, the "title" is the $a mainentry
2676 my ( $auth_type_tag, $auth_type_sf ) = C4::AuthoritiesMarc::get_auth_type_location();
2677 my $authref = C4::AuthoritiesMarc::GetAuthType( $record->subfield( $auth_type_tag, $auth_type_sf ) );
2678 warn "ERROR : authtype undefined for " . $record->as_formatted unless $authref;
2679 $title = $record->subfield( $authref->{auth_tag_to_report}, 'a' );
2680 $index{'mainmainentry'} = $authref->{'auth_tag_to_report'} . 'a';
2681 $index{'mainentry'} = $authref->{'auth_tag_to_report'} . '*';
2682 $index{'auth_type'} = "${auth_type_tag}${auth_type_sf}";
2687 # remove blancks comma (that could cause problem when decoding the string for CQL retrieval) and regexp specific values
2688 $title =~ s/ |,|;|\[|\]|\(|\)|\*|-|'|=//g;
2690 # limit to 10 char, should be enough, and limit the DB size
2691 $title = substr( $title, 0, 10 );
2694 my $sth2 = $dbh->prepare('SELECT biblionumbers FROM nozebra WHERE server=? AND indexname=? AND value=?');
2695 foreach my $field ( $record->fields() ) {
2697 #parse each subfield
2698 next if $field->tag < 10;
2699 foreach my $subfield ( $field->subfields() ) {
2700 my $tag = $field->tag();
2701 my $subfieldcode = $subfield->[0];
2704 # check each index to see if the subfield is stored somewhere
2705 # otherwise, store it in __RAW__ index
2706 foreach my $key ( keys %index ) {
2708 # warn "examining $key index : ".$index{$key}." for $tag $subfieldcode";
2709 if ( $index{$key} =~ /$tag\*/ or $index{$key} =~ /$tag$subfieldcode/ ) {
2711 my $line = lc $subfield->[1];
2713 # remove meaningless value in the field...
2714 $line =~ s/-|\.|\?|,|;|!|'|\(|\)|\[|\]|{|}|"|<|>|&|\+|\*|\/|=|:/ /g;
2716 # ... and split in words
2717 foreach ( split / /, $line ) {
2718 next unless $_; # skip empty values (multiple spaces)
2719 # if the entry is already here, do nothing, the biblionumber has already be removed
2720 unless ( defined( $result{$key}->{$_} ) && ( $result{$key}->{$_} =~ /$biblionumber,$title\-(\d);/ ) ) {
2722 # get the index value if it exist in the nozebra table and remove the entry, otherwise, do nothing
2723 $sth2->execute( $server, $key, $_ );
2724 my $existing_biblionumbers = $sth2->fetchrow;
2727 if ($existing_biblionumbers) {
2729 # warn " existing for $key $_: $existing_biblionumbers";
2730 $result{$key}->{$_} = $existing_biblionumbers;
2731 $result{$key}->{$_} =~ s/$biblionumber,$title\-(\d);//;
2738 # the subfield is not indexed, store it in __RAW__ index anyway
2740 my $line = lc $subfield->[1];
2741 $line =~ s/-|\.|\?|,|;|!|'|\(|\)|\[|\]|{|}|"|<|>|&|\+|\*|\/|=|:/ /g;
2743 # ... and split in words
2744 foreach ( split / /, $line ) {
2745 next unless $_; # skip empty values (multiple spaces)
2746 # if the entry is already here, do nothing, the biblionumber has already be removed
2747 unless ( $result{'__RAW__'}->{$_} =~ /$biblionumber,$title\-(\d);/ ) {
2749 # get the index value if it exist in the nozebra table and remove the entry, otherwise, do nothing
2750 $sth2->execute( $server, '__RAW__', $_ );
2751 my $existing_biblionumbers = $sth2->fetchrow;
2754 if ($existing_biblionumbers) {
2755 $result{'__RAW__'}->{$_} = $existing_biblionumbers;
2756 $result{'__RAW__'}->{$_} =~ s/$biblionumber,$title\-(\d);//;
2766 =head2 _AddBiblioNoZebra
2768 _AddBiblioNoZebra($biblionumber, $record, $server, %result);
2770 function to add a biblio in NoZebra indexes
2774 sub _AddBiblioNoZebra {
2775 my ( $biblionumber, $record, $server, %result ) = @_;
2776 my $dbh = C4::Context->dbh;
2781 if ( $server eq 'biblioserver' ) {
2782 %index = GetNoZebraIndexes;
2784 # get title of the record (to store the 10 first letters with the index)
2785 my ( $titletag, $titlesubfield ) = GetMarcFromKohaField( 'biblio.title', '' ); # FIXME: should be GetFrameworkCode($biblionumber) ??
2786 $title = lc( $record->subfield( $titletag, $titlesubfield ) );
2789 # warn "server : $server";
2790 # for authorities, the "title" is the $a mainentry
2791 my ( $auth_type_tag, $auth_type_sf ) = C4::AuthoritiesMarc::get_auth_type_location();
2792 my $authref = C4::AuthoritiesMarc::GetAuthType( $record->subfield( $auth_type_tag, $auth_type_sf ) );
2793 warn "ERROR : authtype undefined for " . $record->as_formatted unless $authref;
2794 $title = $record->subfield( $authref->{auth_tag_to_report}, 'a' );
2795 $index{'mainmainentry'} = $authref->{auth_tag_to_report} . 'a';
2796 $index{'mainentry'} = $authref->{auth_tag_to_report} . '*';
2797 $index{'auth_type'} = "${auth_type_tag}${auth_type_sf}";
2800 # remove blancks comma (that could cause problem when decoding the string for CQL retrieval) and regexp specific values
2801 $title =~ s/ |\.|,|;|\[|\]|\(|\)|\*|-|'|:|=|\r|\n//g;
2803 # limit to 10 char, should be enough, and limit the DB size
2804 $title = substr( $title, 0, 10 );
2807 my $sth2 = $dbh->prepare('SELECT biblionumbers FROM nozebra WHERE server=? AND indexname=? AND value=?');
2808 foreach my $field ( $record->fields() ) {
2810 #parse each subfield
2811 ###FIXME: impossible to index a 001-009 value with NoZebra
2812 next if $field->tag < 10;
2813 foreach my $subfield ( $field->subfields() ) {
2814 my $tag = $field->tag();
2815 my $subfieldcode = $subfield->[0];
2818 # warn "INDEXING :".$subfield->[1];
2819 # check each index to see if the subfield is stored somewhere
2820 # otherwise, store it in __RAW__ index
2821 foreach my $key ( keys %index ) {
2823 # warn "examining $key index : ".$index{$key}." for $tag $subfieldcode";
2824 if ( $index{$key} =~ /$tag\*/ or $index{$key} =~ /$tag$subfieldcode/ ) {
2826 my $line = lc $subfield->[1];
2828 # remove meaningless value in the field...
2829 $line =~ s/-|\.|\?|,|;|!|'|\(|\)|\[|\]|{|}|"|<|>|&|\+|\*|\/|=|:|\r|\n/ /g;
2831 # ... and split in words
2832 foreach ( split / /, $line ) {
2833 next unless $_; # skip empty values (multiple spaces)
2834 # if the entry is already here, improve weight
2836 # warn "managing $_";
2837 if ( exists $result{$key}->{$_} && $result{$key}->{"$_"} =~ /$biblionumber,\Q$title\E\-(\d+);/ ) {
2838 my $weight = $1 + 1;
2839 $result{$key}->{"$_"} =~ s/$biblionumber,\Q$title\E\-(\d+);//g;
2840 $result{$key}->{"$_"} .= "$biblionumber,$title-$weight;";
2843 # get the value if it exist in the nozebra table, otherwise, create it
2844 $sth2->execute( $server, $key, $_ );
2845 my $existing_biblionumbers = $sth2->fetchrow;
2848 if ($existing_biblionumbers) {
2849 $result{$key}->{"$_"} = $existing_biblionumbers;
2850 my $weight = defined $1 ? $1 + 1 : 1;
2851 $result{$key}->{"$_"} =~ s/$biblionumber,\Q$title\E\-(\d+);//g;
2852 $result{$key}->{"$_"} .= "$biblionumber,$title-$weight;";
2854 # create a new ligne for this entry
2857 # warn "INSERT : $server / $key / $_";
2858 $dbh->do( 'INSERT INTO nozebra SET server=' . $dbh->quote($server) . ', indexname=' . $dbh->quote($key) . ',value=' . $dbh->quote($_) );
2859 $result{$key}->{"$_"} .= "$biblionumber,$title-1;";
2866 # the subfield is not indexed, store it in __RAW__ index anyway
2868 my $line = lc $subfield->[1];
2869 $line =~ s/-|\.|\?|,|;|!|'|\(|\)|\[|\]|{|}|"|<|>|&|\+|\*|\/|=|:|\r|\n/ /g;
2871 # ... and split in words
2872 foreach ( split / /, $line ) {
2873 next unless $_; # skip empty values (multiple spaces)
2874 # if the entry is already here, improve weight
2875 my $tmpstr = $result{'__RAW__'}->{"$_"} || "";
2876 if ( $tmpstr =~ /$biblionumber,\Q$title\E\-(\d+);/ ) {
2877 my $weight = $1 + 1;
2878 $result{'__RAW__'}->{"$_"} =~ s/$biblionumber,\Q$title\E\-(\d+);//;
2879 $result{'__RAW__'}->{"$_"} .= "$biblionumber,$title-$weight;";
2882 # get the value if it exist in the nozebra table, otherwise, create it
2883 $sth2->execute( $server, '__RAW__', $_ );
2884 my $existing_biblionumbers = $sth2->fetchrow;
2887 if ($existing_biblionumbers) {
2888 $result{'__RAW__'}->{"$_"} = $existing_biblionumbers;
2889 my $weight = ( $1 ? $1 : 0 ) + 1;
2890 $result{'__RAW__'}->{"$_"} =~ s/$biblionumber,\Q$title\E\-(\d+);//;
2891 $result{'__RAW__'}->{"$_"} .= "$biblionumber,$title-$weight;";
2893 # create a new ligne for this entry
2895 $dbh->do( 'INSERT INTO nozebra SET server=' . $dbh->quote($server) . ', indexname="__RAW__",value=' . $dbh->quote($_) );
2896 $result{'__RAW__'}->{"$_"} .= "$biblionumber,$title-1;";
2906 =head2 _koha_marc_update_bib_ids
2909 _koha_marc_update_bib_ids($record, $frameworkcode, $biblionumber, $biblioitemnumber);
2911 Internal function to add or update biblionumber and biblioitemnumber to
2916 sub _koha_marc_update_bib_ids {
2917 my ( $record, $frameworkcode, $biblionumber, $biblioitemnumber ) = @_;
2919 # we must add bibnum and bibitemnum in MARC::Record...
2920 # we build the new field with biblionumber and biblioitemnumber
2921 # we drop the original field
2922 # we add the new builded field.
2923 my ( $biblio_tag, $biblio_subfield ) = GetMarcFromKohaField( "biblio.biblionumber", $frameworkcode );
2924 die qq{No biblionumber tag for framework "$frameworkcode"} unless $biblio_tag;
2925 my ( $biblioitem_tag, $biblioitem_subfield ) = GetMarcFromKohaField( "biblioitems.biblioitemnumber", $frameworkcode );
2926 die qq{No biblioitemnumber tag for framework "$frameworkcode"} unless $biblio_tag;
2928 if ( $biblio_tag == $biblioitem_tag ) {
2930 # biblionumber & biblioitemnumber are in the same field (can't be <10 as fields <10 have only 1 value)
2931 my $new_field = MARC::Field->new(
2932 $biblio_tag, '', '',
2933 "$biblio_subfield" => $biblionumber,
2934 "$biblioitem_subfield" => $biblioitemnumber
2937 # drop old field and create new one...
2938 my $old_field = $record->field($biblio_tag);
2939 $record->delete_field($old_field) if $old_field;
2940 $record->insert_fields_ordered($new_field);
2943 # biblionumber & biblioitemnumber are in different fields
2945 # deal with biblionumber
2946 my ( $new_field, $old_field );
2947 if ( $biblio_tag < 10 ) {
2948 $new_field = MARC::Field->new( $biblio_tag, $biblionumber );
2950 $new_field = MARC::Field->new( $biblio_tag, '', '', "$biblio_subfield" => $biblionumber );
2953 # drop old field and create new one...
2954 $old_field = $record->field($biblio_tag);
2955 $record->delete_field($old_field) if $old_field;
2956 $record->insert_fields_ordered($new_field);
2958 # deal with biblioitemnumber
2959 if ( $biblioitem_tag < 10 ) {
2960 $new_field = MARC::Field->new( $biblioitem_tag, $biblioitemnumber, );
2962 $new_field = MARC::Field->new( $biblioitem_tag, '', '', "$biblioitem_subfield" => $biblioitemnumber, );
2965 # drop old field and create new one...
2966 $old_field = $record->field($biblioitem_tag);
2967 $record->delete_field($old_field) if $old_field;
2968 $record->insert_fields_ordered($new_field);
2972 =head2 _koha_marc_update_biblioitem_cn_sort
2974 _koha_marc_update_biblioitem_cn_sort($marc, $biblioitem, $frameworkcode);
2976 Given a MARC bib record and the biblioitem hash, update the
2977 subfield that contains a copy of the value of biblioitems.cn_sort.
2981 sub _koha_marc_update_biblioitem_cn_sort {
2983 my $biblioitem = shift;
2984 my $frameworkcode = shift;
2986 my ( $biblioitem_tag, $biblioitem_subfield ) = GetMarcFromKohaField( "biblioitems.cn_sort", $frameworkcode );
2987 return unless $biblioitem_tag;
2989 my ($cn_sort) = GetClassSort( $biblioitem->{'biblioitems.cn_source'}, $biblioitem->{'cn_class'}, $biblioitem->{'cn_item'} );
2991 if ( my $field = $marc->field($biblioitem_tag) ) {
2992 $field->delete_subfield( code => $biblioitem_subfield );
2993 if ( $cn_sort ne '' ) {
2994 $field->add_subfields( $biblioitem_subfield => $cn_sort );
2998 # if we get here, no biblioitem tag is present in the MARC record, so
2999 # we'll create it if $cn_sort is not empty -- this would be
3000 # an odd combination of events, however
3002 $marc->insert_grouped_field( MARC::Field->new( $biblioitem_tag, ' ', ' ', $biblioitem_subfield => $cn_sort ) );
3007 =head2 _koha_add_biblio
3009 my ($biblionumber,$error) = _koha_add_biblio($dbh,$biblioitem);
3011 Internal function to add a biblio ($biblio is a hash with the values)
3015 sub _koha_add_biblio {
3016 my ( $dbh, $biblio, $frameworkcode ) = @_;
3020 # set the series flag
3021 unless (defined $biblio->{'serial'}){
3022 $biblio->{'serial'} = 0;
3023 if ( $biblio->{'seriestitle'} ) { $biblio->{'serial'} = 1 }
3026 my $query = "INSERT INTO biblio
3027 SET frameworkcode = ?,
3038 my $sth = $dbh->prepare($query);
3040 $frameworkcode, $biblio->{'author'}, $biblio->{'title'}, $biblio->{'unititle'}, $biblio->{'notes'},
3041 $biblio->{'serial'}, $biblio->{'seriestitle'}, $biblio->{'copyrightdate'}, $biblio->{'abstract'}
3044 my $biblionumber = $dbh->{'mysql_insertid'};
3045 if ( $dbh->errstr ) {
3046 $error .= "ERROR in _koha_add_biblio $query" . $dbh->errstr;
3052 #warn "LEAVING _koha_add_biblio: ".$biblionumber."\n";
3053 return ( $biblionumber, $error );
3056 =head2 _koha_modify_biblio
3058 my ($biblionumber,$error) == _koha_modify_biblio($dbh,$biblio,$frameworkcode);
3060 Internal function for updating the biblio table
3064 sub _koha_modify_biblio {
3065 my ( $dbh, $biblio, $frameworkcode ) = @_;
3070 SET frameworkcode = ?,
3079 WHERE biblionumber = ?
3082 my $sth = $dbh->prepare($query);
3085 $frameworkcode, $biblio->{'author'}, $biblio->{'title'}, $biblio->{'unititle'}, $biblio->{'notes'},
3086 $biblio->{'serial'}, $biblio->{'seriestitle'}, $biblio->{'copyrightdate'}, $biblio->{'abstract'}, $biblio->{'biblionumber'}
3087 ) if $biblio->{'biblionumber'};
3089 if ( $dbh->errstr || !$biblio->{'biblionumber'} ) {
3090 $error .= "ERROR in _koha_modify_biblio $query" . $dbh->errstr;
3093 return ( $biblio->{'biblionumber'}, $error );
3096 =head2 _koha_modify_biblioitem_nonmarc
3098 my ($biblioitemnumber,$error) = _koha_modify_biblioitem_nonmarc( $dbh, $biblioitem );
3100 Updates biblioitems row except for marc and marcxml, which should be changed
3105 sub _koha_modify_biblioitem_nonmarc {
3106 my ( $dbh, $biblioitem ) = @_;
3109 # re-calculate the cn_sort, it may have changed
3110 my ($cn_sort) = GetClassSort( $biblioitem->{'biblioitems.cn_source'}, $biblioitem->{'cn_class'}, $biblioitem->{'cn_item'} );
3112 my $query = "UPDATE biblioitems
3113 SET biblionumber = ?,
3119 publicationyear = ?,
3123 collectiontitle = ?,
3125 collectionvolume= ?,
3126 editionstatement= ?,
3127 editionresponsibility = ?,
3141 where biblioitemnumber = ?
3143 my $sth = $dbh->prepare($query);
3145 $biblioitem->{'biblionumber'}, $biblioitem->{'volume'}, $biblioitem->{'number'}, $biblioitem->{'itemtype'},
3146 $biblioitem->{'isbn'}, $biblioitem->{'issn'}, $biblioitem->{'publicationyear'}, $biblioitem->{'publishercode'},
3147 $biblioitem->{'volumedate'}, $biblioitem->{'volumedesc'}, $biblioitem->{'collectiontitle'}, $biblioitem->{'collectionissn'},
3148 $biblioitem->{'collectionvolume'}, $biblioitem->{'editionstatement'}, $biblioitem->{'editionresponsibility'}, $biblioitem->{'illus'},
3149 $biblioitem->{'pages'}, $biblioitem->{'bnotes'}, $biblioitem->{'size'}, $biblioitem->{'place'},
3150 $biblioitem->{'lccn'}, $biblioitem->{'url'}, $biblioitem->{'biblioitems.cn_source'}, $biblioitem->{'cn_class'},
3151 $biblioitem->{'cn_item'}, $biblioitem->{'cn_suffix'}, $cn_sort, $biblioitem->{'totalissues'},
3152 $biblioitem->{'biblioitemnumber'}
3154 if ( $dbh->errstr ) {
3155 $error .= "ERROR in _koha_modify_biblioitem_nonmarc $query" . $dbh->errstr;
3158 return ( $biblioitem->{'biblioitemnumber'}, $error );
3161 =head2 _koha_add_biblioitem
3163 my ($biblioitemnumber,$error) = _koha_add_biblioitem( $dbh, $biblioitem );
3165 Internal function to add a biblioitem
3169 sub _koha_add_biblioitem {
3170 my ( $dbh, $biblioitem ) = @_;
3173 my ($cn_sort) = GetClassSort( $biblioitem->{'biblioitems.cn_source'}, $biblioitem->{'cn_class'}, $biblioitem->{'cn_item'} );
3174 my $query = "INSERT INTO biblioitems SET
3181 publicationyear = ?,
3185 collectiontitle = ?,
3187 collectionvolume= ?,
3188 editionstatement= ?,
3189 editionresponsibility = ?,
3205 my $sth = $dbh->prepare($query);
3207 $biblioitem->{'biblionumber'}, $biblioitem->{'volume'}, $biblioitem->{'number'}, $biblioitem->{'itemtype'},
3208 $biblioitem->{'isbn'}, $biblioitem->{'issn'}, $biblioitem->{'publicationyear'}, $biblioitem->{'publishercode'},
3209 $biblioitem->{'volumedate'}, $biblioitem->{'volumedesc'}, $biblioitem->{'collectiontitle'}, $biblioitem->{'collectionissn'},
3210 $biblioitem->{'collectionvolume'}, $biblioitem->{'editionstatement'}, $biblioitem->{'editionresponsibility'}, $biblioitem->{'illus'},
3211 $biblioitem->{'pages'}, $biblioitem->{'bnotes'}, $biblioitem->{'size'}, $biblioitem->{'place'},
3212 $biblioitem->{'lccn'}, $biblioitem->{'marc'}, $biblioitem->{'url'}, $biblioitem->{'biblioitems.cn_source'},
3213 $biblioitem->{'cn_class'}, $biblioitem->{'cn_item'}, $biblioitem->{'cn_suffix'}, $cn_sort,
3214 $biblioitem->{'totalissues'}
3216 my $bibitemnum = $dbh->{'mysql_insertid'};
3218 if ( $dbh->errstr ) {
3219 $error .= "ERROR in _koha_add_biblioitem $query" . $dbh->errstr;
3223 return ( $bibitemnum, $error );
3226 =head2 _koha_delete_biblio
3228 $error = _koha_delete_biblio($dbh,$biblionumber);
3230 Internal sub for deleting from biblio table -- also saves to deletedbiblio
3232 C<$dbh> - the database handle
3234 C<$biblionumber> - the biblionumber of the biblio to be deleted
3238 # FIXME: add error handling
3240 sub _koha_delete_biblio {
3241 my ( $dbh, $biblionumber ) = @_;
3243 # get all the data for this biblio
3244 my $sth = $dbh->prepare("SELECT * FROM biblio WHERE biblionumber=?");
3245 $sth->execute($biblionumber);
3247 if ( my $data = $sth->fetchrow_hashref ) {
3249 # save the record in deletedbiblio
3250 # find the fields to save
3251 my $query = "INSERT INTO deletedbiblio SET ";
3253 foreach my $temp ( keys %$data ) {
3254 $query .= "$temp = ?,";
3255 push( @bind, $data->{$temp} );
3258 # replace the last , by ",?)"
3260 my $bkup_sth = $dbh->prepare($query);
3261 $bkup_sth->execute(@bind);
3265 my $sth2 = $dbh->prepare("DELETE FROM biblio WHERE biblionumber=?");
3266 $sth2->execute($biblionumber);
3267 # update the timestamp (Bugzilla 7146)
3268 $sth2= $dbh->prepare("UPDATE deletedbiblio SET timestamp=NOW() WHERE biblionumber=?");
3269 $sth2->execute($biblionumber);
3276 =head2 _koha_delete_biblioitems
3278 $error = _koha_delete_biblioitems($dbh,$biblioitemnumber);
3280 Internal sub for deleting from biblioitems table -- also saves to deletedbiblioitems
3282 C<$dbh> - the database handle
3283 C<$biblionumber> - the biblioitemnumber of the biblioitem to be deleted
3287 # FIXME: add error handling
3289 sub _koha_delete_biblioitems {
3290 my ( $dbh, $biblioitemnumber ) = @_;
3292 # get all the data for this biblioitem
3293 my $sth = $dbh->prepare("SELECT * FROM biblioitems WHERE biblioitemnumber=?");
3294 $sth->execute($biblioitemnumber);
3296 if ( my $data = $sth->fetchrow_hashref ) {
3298 # save the record in deletedbiblioitems
3299 # find the fields to save
3300 my $query = "INSERT INTO deletedbiblioitems SET ";
3302 foreach my $temp ( keys %$data ) {
3303 $query .= "$temp = ?,";
3304 push( @bind, $data->{$temp} );
3307 # replace the last , by ",?)"
3309 my $bkup_sth = $dbh->prepare($query);
3310 $bkup_sth->execute(@bind);
3313 # delete the biblioitem
3314 my $sth2 = $dbh->prepare("DELETE FROM biblioitems WHERE biblioitemnumber=?");
3315 $sth2->execute($biblioitemnumber);
3316 # update the timestamp (Bugzilla 7146)
3317 $sth2= $dbh->prepare("UPDATE deletedbiblioitems SET timestamp=NOW() WHERE biblioitemnumber=?");
3318 $sth2->execute($biblioitemnumber);
3325 =head1 UNEXPORTED FUNCTIONS
3327 =head2 ModBiblioMarc
3329 &ModBiblioMarc($newrec,$biblionumber,$frameworkcode);
3331 Add MARC data for a biblio to koha
3333 Function exported, but should NOT be used, unless you really know what you're doing
3339 # pass the MARC::Record to this function, and it will create the records in the marc field
3340 my ( $record, $biblionumber, $frameworkcode ) = @_;
3341 my $dbh = C4::Context->dbh;
3342 my @fields = $record->fields();
3343 if ( !$frameworkcode ) {
3344 $frameworkcode = "";
3346 my $sth = $dbh->prepare("UPDATE biblio SET frameworkcode=? WHERE biblionumber=?");
3347 $sth->execute( $frameworkcode, $biblionumber );
3349 my $encoding = C4::Context->preference("marcflavour");
3351 # deal with UNIMARC field 100 (encoding) : create it if needed & set encoding to unicode
3352 if ( $encoding eq "UNIMARC" ) {
3353 my $string = $record->subfield( 100, "a" );
3354 if ( ($string) && ( length( $record->subfield( 100, "a" ) ) == 36 ) ) {
3355 my $f100 = $record->field(100);
3356 $record->delete_field($f100);
3358 $string = POSIX::strftime( "%Y%m%d", localtime );
3360 $string = sprintf( "%-*s", 35, $string );
3362 substr( $string, 22, 6, "frey50" );
3363 unless ( $record->subfield( 100, "a" ) ) {
3364 $record->insert_fields_ordered( MARC::Field->new( 100, "", "", "a" => $string ) );
3368 #enhancement 5374: update transaction date (005) for marc21/unimarc
3369 if($encoding =~ /MARC21|UNIMARC/) {
3370 my @a= (localtime) [5,4,3,2,1,0]; $a[0]+=1900; $a[1]++;
3371 # YY MM DD HH MM SS (update year and month)
3372 my $f005= $record->field('005');
3373 $f005->update(sprintf("%4d%02d%02d%02d%02d%04.1f",@a)) if $f005;
3377 if ( C4::Context->preference("NoZebra") ) {
3379 # only NoZebra indexing needs to have
3380 # the previous version of the record
3381 $oldRecord = GetMarcBiblio($biblionumber);
3383 $sth = $dbh->prepare("UPDATE biblioitems SET marc=?,marcxml=? WHERE biblionumber=?");
3384 $sth->execute( $record->as_usmarc(), $record->as_xml_record($encoding), $biblionumber );
3386 ModZebra( $biblionumber, "specialUpdate", "biblioserver", $oldRecord, $record );
3387 return $biblionumber;
3390 =head2 get_biblio_authorised_values
3392 find the types and values for all authorised values assigned to this biblio.
3396 MARC::Record of the bib
3398 returns: a hashref mapping the authorised value to the value set for this biblionumber
3400 $authorised_values = {
3401 'Scent' => 'flowery',
3402 'Audience' => 'Young Adult',
3403 'itemtypes' => 'SER',
3406 Notes: forlibrarian should probably be passed in, and called something different.
3410 sub get_biblio_authorised_values {
3411 my $biblionumber = shift;
3414 my $forlibrarian = 1; # are we in staff or opac?
3415 my $frameworkcode = GetFrameworkCode($biblionumber);
3417 my $authorised_values;
3419 my $tagslib = GetMarcStructure( $forlibrarian, $frameworkcode )
3420 or return $authorised_values;
3422 # assume that these entries in the authorised_value table are bibliolevel.
3423 # ones that start with 'item%' are item level.
3424 my $query = q(SELECT distinct authorised_value, kohafield
3425 FROM marc_subfield_structure
3426 WHERE authorised_value !=''
3427 AND (kohafield like 'biblio%'
3428 OR kohafield like '') );
3429 my $bibliolevel_authorised_values = C4::Context->dbh->selectall_hashref( $query, 'authorised_value' );
3431 foreach my $tag ( keys(%$tagslib) ) {
3432 foreach my $subfield ( keys( %{ $tagslib->{$tag} } ) ) {
3434 # warn "checking $subfield. type is: " . ref $tagslib->{ $tag }{ $subfield };
3435 if ( 'HASH' eq ref $tagslib->{$tag}{$subfield} ) {
3436 if ( defined $tagslib->{$tag}{$subfield}{'authorised_value'} && exists $bibliolevel_authorised_values->{ $tagslib->{$tag}{$subfield}{'authorised_value'} } ) {
3437 if ( defined $record->field($tag) ) {
3438 my $this_subfield_value = $record->field($tag)->subfield($subfield);
3439 if ( defined $this_subfield_value ) {
3440 $authorised_values->{ $tagslib->{$tag}{$subfield}{'authorised_value'} } = $this_subfield_value;
3448 # warn ( Data::Dumper->Dump( [ $authorised_values ], [ 'authorised_values' ] ) );
3449 return $authorised_values;
3452 =head2 CountBiblioInOrders
3455 $count = &CountBiblioInOrders( $biblionumber);
3459 This function return count of biblios in orders with $biblionumber
3463 sub CountBiblioInOrders {
3464 my ($biblionumber) = @_;
3465 my $dbh = C4::Context->dbh;
3466 my $query = "SELECT count(*)
3468 WHERE biblionumber=? AND (datecancellationprinted IS NULL OR datecancellationprinted='0000-00-00')";
3469 my $sth = $dbh->prepare($query);
3470 $sth->execute($biblionumber);
3471 my $count = $sth->fetchrow;
3475 =head2 GetSubscriptionsId
3478 $subscriptions = &GetSubscriptionsId($biblionumber);
3482 This function return an array of subscriptionid with $biblionumber
3486 sub GetSubscriptionsId {
3487 my ($biblionumber) = @_;
3488 my $dbh = C4::Context->dbh;
3489 my $query = "SELECT subscriptionid
3491 WHERE biblionumber=?";
3492 my $sth = $dbh->prepare($query);
3493 $sth->execute($biblionumber);
3494 my @subscriptions = $sth->fetchrow_array;
3495 return (@subscriptions);
3501 $holds = &GetHolds($biblionumber);
3505 This function return the count of holds with $biblionumber
3510 my ($biblionumber) = @_;
3511 my $dbh = C4::Context->dbh;
3512 my $query = "SELECT count(*)
3514 WHERE biblionumber=?";
3515 my $sth = $dbh->prepare($query);
3516 $sth->execute($biblionumber);
3517 my $holds = $sth->fetchrow;
3528 Koha Development Team <http://koha-community.org/>
3530 Paul POULAIN paul.poulain@free.fr
3532 Joshua Ferraro jmf@liblime.com