3 # Copyright 2000-2002 Katipo Communications
5 # This file is part of Koha.
7 # Koha is free software; you can redistribute it and/or modify it under the
8 # terms of the GNU General Public License as published by the Free Software
9 # Foundation; either version 2 of the License, or (at your option) any later
12 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
13 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
14 # A PARTICULAR PURPOSE. See the GNU General Public License for more details.
16 # You should have received a copy of the GNU General Public License along with
17 # Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
18 # Suite 330, Boston, MA 02111-1307 USA
23 use MARC::File::USMARC;
30 use C4::Dates qw/format_date/;
31 use C4::Log; # logaction
36 use vars qw($VERSION @ISA @EXPORT);
42 @ISA = qw( Exporter );
56 &GetBiblioItemByBiblioNumber
57 &GetBiblioFromItemNumber
68 &GetAuthorisedValueDesc
72 &GetPublisherNameFromIsbn
87 # To link headings in a bib record
88 # to authority records.
90 &LinkBibHeadingsToAuthorities
94 # those functions are exported but should not be used
95 # they are usefull is few circumstances, so are exported.
96 # but don't use them unless you're a core developer ;-)
103 &TransformHtmlToMarc2
106 &PrepareItemrecordDisplay
111 # because of interdependencies between
112 # C4::Search, C4::Heading, and C4::Biblio,
113 # 'use C4::Heading' must occur after
114 # the exports have been defined.
119 C4::Biblio - cataloging management functions
123 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:
127 =item 1. in the biblio,biblioitems,items, etc tables, which are limited to a one-to-one mapping to underlying MARC data
129 =item 2. as raw MARC in the Zebra index and storage engine
131 =item 3. as raw MARC the biblioitems.marc and biblioitems.marcxml
135 In the 3.0 version of Koha, the authoritative record-level information is in biblioitems.marcxml
137 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.
141 =item 1. Compared with MySQL, Zebra is slow to update an index for small data changes -- especially for proc-intensive operations like circulation
143 =item 2. Zebra's index has been known to crash and a backup of the data is necessary to rebuild it in such cases
147 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:
151 =item 1. Add*/Mod*/Del*/ - high-level external functions suitable for being called from external scripts to manage the collection
153 =item 2. _koha_* - low-level internal functions for managing the koha tables
155 =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.
157 =item 4. Zebra functions used to update the Zebra index
159 =item 5. internal helper functions such as char_decode, checkitems, etc. Some of these probably belong in Koha.pm
163 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 :
167 =item 1. save datas in biblio and biblioitems table, that gives us a biblionumber and a biblioitemnumber
169 =item 2. add the biblionumber and biblioitemnumber into the MARC records
171 =item 3. save the marc record
175 When dealing with items, we must :
179 =item 1. save the item in items table, that gives us an itemnumber
181 =item 2. add the itemnumber to the item MARC field
183 =item 3. overwrite the MARC record (with the added item) into biblioitems.marc(xml)
185 When modifying a biblio or an item, the behaviour is quite similar.
189 =head1 EXPORTED FUNCTIONS
195 ($biblionumber,$biblioitemnumber) = AddBiblio($record,$frameworkcode);
199 Exported function (core API) for adding a new biblio to koha.
201 The first argument is a C<MARC::Record> object containing the
202 bib to add, while the second argument is the desired MARC
205 This function also accepts a third, optional argument: a hashref
206 to additional options. The only defined option is C<defer_marc_save>,
207 which if present and mapped to a true value, causes C<AddBiblio>
208 to omit the call to save the MARC in C<bibilioitems.marc>
209 and C<biblioitems.marcxml> This option is provided B<only>
210 for the use of scripts such as C<bulkmarcimport.pl> that may need
211 to do some manipulation of the MARC record for item parsing before
212 saving it and which cannot afford the performance hit of saving
213 the MARC record twice. Consequently, do not use that option
214 unless you can guarantee that C<ModBiblioMarc> will be called.
220 my $frameworkcode = shift;
221 my $options = @_ ? shift : undef;
222 my $defer_marc_save = 0;
223 if (defined $options and exists $options->{'defer_marc_save'} and $options->{'defer_marc_save'}) {
224 $defer_marc_save = 1;
227 my ($biblionumber,$biblioitemnumber,$error);
228 my $dbh = C4::Context->dbh;
229 # transform the data into koha-table style data
230 my $olddata = TransformMarcToKoha( $dbh, $record, $frameworkcode );
231 ($biblionumber,$error) = _koha_add_biblio( $dbh, $olddata, $frameworkcode );
232 $olddata->{'biblionumber'} = $biblionumber;
233 ($biblioitemnumber,$error) = _koha_add_biblioitem( $dbh, $olddata );
235 _koha_marc_update_bib_ids($record, $frameworkcode, $biblionumber, $biblioitemnumber);
237 # update MARC subfield that stores biblioitems.cn_sort
238 _koha_marc_update_biblioitem_cn_sort($record, $olddata, $frameworkcode);
241 $biblionumber = ModBiblioMarc( $record, $biblionumber, $frameworkcode ) unless $defer_marc_save;
243 &logaction(C4::Context->userenv->{'number'},"CATALOGUING","ADD",$biblionumber,"biblio")
244 if C4::Context->preference("CataloguingLog");
246 return ( $biblionumber, $biblioitemnumber );
251 ModBiblio( $record,$biblionumber,$frameworkcode);
252 Exported function (core API) to modify a biblio
257 my ( $record, $biblionumber, $frameworkcode ) = @_;
258 if (C4::Context->preference("CataloguingLog")) {
259 my $newrecord = GetMarcBiblio($biblionumber);
260 &logaction(C4::Context->userenv->{'number'},"CATALOGUING","MODIFY",$biblionumber,"BEFORE=>".$newrecord->as_formatted);
263 my $dbh = C4::Context->dbh;
265 $frameworkcode = "" unless $frameworkcode;
267 # get the items before and append them to the biblio before updating the record, atm we just have the biblio
268 my ( $itemtag, $itemsubfield ) = GetMarcFromKohaField("items.itemnumber",$frameworkcode);
269 my $oldRecord = GetMarcBiblio( $biblionumber );
271 # parse each item, and, for an unknown reason, re-encode each subfield
272 # if you don't do that, the record will have encoding mixed
273 # and the biblio will be re-encoded.
274 # strange, I (Paul P.) searched more than 1 day to understand what happends
275 # but could only solve the problem this way...
276 my @fields = $oldRecord->field( $itemtag );
277 foreach my $fielditem ( @fields ){
279 foreach ($fielditem->subfields()) {
281 $field->add_subfields(Encode::encode('utf-8',$_->[0]) => Encode::encode('utf-8',$_->[1]));
283 $field = MARC::Field->new("$itemtag",'','',Encode::encode('utf-8',$_->[0]) => Encode::encode('utf-8',$_->[1]));
286 $record->append_fields($field);
289 # update biblionumber and biblioitemnumber in MARC
290 # FIXME - this is assuming a 1 to 1 relationship between
291 # biblios and biblioitems
292 my $sth = $dbh->prepare("select biblioitemnumber from biblioitems where biblionumber=?");
293 $sth->execute($biblionumber);
294 my ($biblioitemnumber) = $sth->fetchrow;
296 _koha_marc_update_bib_ids($record, $frameworkcode, $biblionumber, $biblioitemnumber);
298 # load the koha-table data object
299 my $oldbiblio = TransformMarcToKoha( $dbh, $record, $frameworkcode );
301 # update MARC subfield that stores biblioitems.cn_sort
302 _koha_marc_update_biblioitem_cn_sort($record, $oldbiblio, $frameworkcode);
304 # update the MARC record (that now contains biblio and items) with the new record data
305 &ModBiblioMarc( $record, $biblionumber, $frameworkcode );
307 # modify the other koha tables
308 _koha_modify_biblio( $dbh, $oldbiblio, $frameworkcode );
309 _koha_modify_biblioitem_nonmarc( $dbh, $oldbiblio );
313 =head2 ModBiblioframework
315 ModBiblioframework($biblionumber,$frameworkcode);
316 Exported function to modify a biblio framework
320 sub ModBiblioframework {
321 my ( $biblionumber, $frameworkcode ) = @_;
322 my $dbh = C4::Context->dbh;
323 my $sth = $dbh->prepare(
324 "UPDATE biblio SET frameworkcode=? WHERE biblionumber=?"
326 $sth->execute($frameworkcode, $biblionumber);
334 my $error = &DelBiblio($dbh,$biblionumber);
335 Exported function (core API) for deleting a biblio in koha.
336 Deletes biblio record from Zebra and Koha tables (biblio,biblioitems,items)
337 Also backs it up to deleted* tables
338 Checks to make sure there are not issues on any of the items
340 C<$error> : undef unless an error occurs
347 my ( $biblionumber ) = @_;
348 my $dbh = C4::Context->dbh;
349 my $error; # for error handling
351 # First make sure this biblio has no items attached
352 my $sth = $dbh->prepare("SELECT itemnumber FROM items WHERE biblionumber=?");
353 $sth->execute($biblionumber);
354 if (my $itemnumber = $sth->fetchrow){
355 # Fix this to use a status the template can understand
356 $error .= "This Biblio has items attached, please delete them first before deleting this biblio ";
359 return $error if $error;
361 # Delete in Zebra. Be careful NOT to move this line after _koha_delete_biblio
362 # for at least 2 reasons :
363 # - we need to read the biblio if NoZebra is set (to remove it from the indexes
364 # - if something goes wrong, the biblio may be deleted from Koha but not from zebra
365 # 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)
366 ModZebra($biblionumber, "recordDelete", "biblioserver", undef);
368 # delete biblioitems and items from Koha tables and save in deletedbiblioitems,deleteditems
371 "SELECT biblioitemnumber FROM biblioitems WHERE biblionumber=?");
372 $sth->execute($biblionumber);
373 while ( my $biblioitemnumber = $sth->fetchrow ) {
375 # delete this biblioitem
376 $error = _koha_delete_biblioitems( $dbh, $biblioitemnumber );
377 return $error if $error;
380 # delete biblio from Koha tables and save in deletedbiblio
381 # must do this *after* _koha_delete_biblioitems, otherwise
382 # delete cascade will prevent deletedbiblioitems rows
383 # from being generated by _koha_delete_biblioitems
384 $error = _koha_delete_biblio( $dbh, $biblionumber );
386 &logaction(C4::Context->userenv->{'number'},"CATALOGUING","DELETE",$biblionumber,"")
387 if C4::Context->preference("CataloguingLog");
391 =head2 LinkBibHeadingsToAuthorities
395 my $headings_linked = LinkBibHeadingsToAuthorities($marc);
399 Links bib headings to authority records by checking
400 each authority-controlled field in the C<MARC::Record>
401 object C<$marc>, looking for a matching authority record,
402 and setting the linking subfield $9 to the ID of that
405 If no matching authority exists, or if multiple
406 authorities match, no $9 will be added, and any
407 existing one inthe field will be deleted.
409 Returns the number of heading links changed in the
414 sub LinkBibHeadingsToAuthorities {
417 my $num_headings_changed = 0;
418 foreach my $field ($bib->fields()) {
419 my $heading = C4::Heading->new_from_bib_field($field);
420 next unless defined $heading;
423 my $current_link = $field->subfield('9');
425 # look for matching authorities
426 my $authorities = $heading->authorities();
428 # want only one exact match
429 if ($#{ $authorities } == 0) {
430 my $authority = MARC::Record->new_from_usmarc($authorities->[0]);
431 my $authid = $authority->field('001')->data();
432 next if defined $current_link and $current_link eq $authid;
434 $field->delete_subfield(code => '9') if defined $current_link;
435 $field->add_subfields('9', $authid);
436 $num_headings_changed++;
438 if (defined $current_link) {
439 $field->delete_subfield(code => '9');
440 $num_headings_changed++;
445 return $num_headings_changed;
452 $data = &GetBiblioData($biblionumber);
453 Returns information about the book with the given biblionumber.
454 C<&GetBiblioData> returns a reference-to-hash. The keys are the fields in
455 the C<biblio> and C<biblioitems> tables in the
457 In addition, C<$data-E<gt>{subject}> is the list of the book's
458 subjects, separated by C<" , "> (space, comma, space).
459 If there are multiple biblioitems with the given biblionumber, only
460 the first one is considered.
468 my $dbh = C4::Context->dbh;
470 # my $query = C4::Context->preference('item-level_itypes') ?
471 # " SELECT * , biblioitems.notes AS bnotes, biblio.notes
473 # LEFT JOIN biblioitems ON biblio.biblionumber = biblioitems.biblionumber
474 # WHERE biblio.biblionumber = ?
475 # AND biblioitems.biblionumber = biblio.biblionumber
478 my $query = " SELECT * , biblioitems.notes AS bnotes, itemtypes.notforloan as bi_notforloan, biblio.notes
480 LEFT JOIN biblioitems ON biblio.biblionumber = biblioitems.biblionumber
481 LEFT JOIN itemtypes ON biblioitems.itemtype = itemtypes.itemtype
482 WHERE biblio.biblionumber = ?
483 AND biblioitems.biblionumber = biblio.biblionumber ";
485 my $sth = $dbh->prepare($query);
486 $sth->execute($bibnum);
488 $data = $sth->fetchrow_hashref;
492 } # sub GetBiblioData
494 =head2 &GetBiblioItemData
498 $itemdata = &GetBiblioItemData($biblioitemnumber);
500 Looks up the biblioitem with the given biblioitemnumber. Returns a
501 reference-to-hash. The keys are the fields from the C<biblio>,
502 C<biblioitems>, and C<itemtypes> tables in the Koha database, except
503 that C<biblioitems.notes> is given as C<$itemdata-E<gt>{bnotes}>.
510 sub GetBiblioItemData {
511 my ($biblioitemnumber) = @_;
512 my $dbh = C4::Context->dbh;
513 my $query = "SELECT *,biblioitems.notes AS bnotes
514 FROM biblio LEFT JOIN biblioitems on biblio.biblionumber=biblioitems.biblioitemnumber ";
515 unless(C4::Context->preference('item-level_itypes')) {
516 $query .= "LEFT JOIN itemtypes on biblioitems.itemtype=itemtypes.itemtype ";
518 $query .= " WHERE biblioitemnumber = ? ";
519 my $sth = $dbh->prepare($query);
521 $sth->execute($biblioitemnumber);
522 $data = $sth->fetchrow_hashref;
525 } # sub &GetBiblioItemData
527 =head2 GetBiblioItemByBiblioNumber
531 NOTE : This function has been copy/paste from C4/Biblio.pm from head before zebra integration.
537 sub GetBiblioItemByBiblioNumber {
538 my ($biblionumber) = @_;
539 my $dbh = C4::Context->dbh;
540 my $sth = $dbh->prepare("Select * FROM biblioitems WHERE biblionumber = ?");
544 $sth->execute($biblionumber);
546 while ( my $data = $sth->fetchrow_hashref ) {
547 push @results, $data;
554 =head2 GetBiblioFromItemNumber
558 $item = &GetBiblioFromItemNumber($itemnumber,$barcode);
560 Looks up the item with the given itemnumber. if undef, try the barcode.
562 C<&itemnodata> returns a reference-to-hash whose keys are the fields
563 from the C<biblio>, C<biblioitems>, and C<items> tables in the Koha
571 sub GetBiblioFromItemNumber {
572 my ( $itemnumber, $barcode ) = @_;
573 my $dbh = C4::Context->dbh;
576 $sth=$dbh->prepare( "SELECT * FROM items
577 LEFT JOIN biblio ON biblio.biblionumber = items.biblionumber
578 LEFT JOIN biblioitems ON biblioitems.biblioitemnumber = items.biblioitemnumber
579 WHERE items.itemnumber = ?") ;
580 $sth->execute($itemnumber);
582 $sth=$dbh->prepare( "SELECT * FROM items
583 LEFT JOIN biblio ON biblio.biblionumber = items.biblionumber
584 LEFT JOIN biblioitems ON biblioitems.biblioitemnumber = items.biblioitemnumber
585 WHERE items.barcode = ?") ;
586 $sth->execute($barcode);
588 my $data = $sth->fetchrow_hashref;
597 ( $count, @results ) = &GetBiblio($biblionumber);
604 my ($biblionumber) = @_;
605 my $dbh = C4::Context->dbh;
606 my $sth = $dbh->prepare("SELECT * FROM biblio WHERE biblionumber = ?");
609 $sth->execute($biblionumber);
610 while ( my $data = $sth->fetchrow_hashref ) {
611 $results[$count] = $data;
615 return ( $count, @results );
618 =head2 GetBiblioItemInfosOf
622 GetBiblioItemInfosOf(@biblioitemnumbers);
628 sub GetBiblioItemInfosOf {
629 my @biblioitemnumbers = @_;
632 SELECT biblioitemnumber,
636 WHERE biblioitemnumber IN (' . join( ',', @biblioitemnumbers ) . ')
638 return get_infos_of( $query, 'biblioitemnumber' );
641 =head1 FUNCTIONS FOR HANDLING MARC MANAGEMENT
643 =head2 GetMarcStructure
647 $res = GetMarcStructure($forlibrarian,$frameworkcode);
649 Returns a reference to a big hash of hash, with the Marc structure for the given frameworkcode
650 $forlibrarian :if set to 1, the MARC descriptions are the librarians ones, otherwise it's the public (OPAC) ones
651 $frameworkcode : the framework code to read
657 # cache for results of GetMarcStructure -- needed
659 our $marc_structure_cache;
661 sub GetMarcStructure {
662 my ( $forlibrarian, $frameworkcode ) = @_;
663 my $dbh=C4::Context->dbh;
664 $frameworkcode = "" unless $frameworkcode;
666 if (defined $marc_structure_cache and exists $marc_structure_cache->{$forlibrarian}->{$frameworkcode}) {
667 return $marc_structure_cache->{$forlibrarian}->{$frameworkcode};
671 my $libfield = ( $forlibrarian eq 1 ) ? 'liblibrarian' : 'libopac';
673 # check that framework exists
676 "SELECT COUNT(*) FROM marc_tag_structure WHERE frameworkcode=?");
677 $sth->execute($frameworkcode);
678 my ($total) = $sth->fetchrow;
679 $frameworkcode = "" unless ( $total > 0 );
682 "SELECT tagfield,liblibrarian,libopac,mandatory,repeatable
683 FROM marc_tag_structure
684 WHERE frameworkcode=?
687 $sth->execute($frameworkcode);
688 my ( $liblibrarian, $libopac, $tag, $res, $tab, $mandatory, $repeatable );
690 while ( ( $tag, $liblibrarian, $libopac, $mandatory, $repeatable ) =
693 $res->{$tag}->{lib} =
694 ( $forlibrarian or !$libopac ) ? $liblibrarian : $libopac;
695 $res->{$tab}->{tab} = "";
696 $res->{$tag}->{mandatory} = $mandatory;
697 $res->{$tag}->{repeatable} = $repeatable;
702 "SELECT tagfield,tagsubfield,liblibrarian,libopac,tab,mandatory,repeatable,authorised_value,authtypecode,value_builder,kohafield,seealso,hidden,isurl,link,defaultvalue
703 FROM marc_subfield_structure
704 WHERE frameworkcode=?
705 ORDER BY tagfield,tagsubfield
709 $sth->execute($frameworkcode);
712 my $authorised_value;
724 $tag, $subfield, $liblibrarian,
726 $mandatory, $repeatable, $authorised_value,
727 $authtypecode, $value_builder, $kohafield,
728 $seealso, $hidden, $isurl,
734 $res->{$tag}->{$subfield}->{lib} =
735 ( $forlibrarian or !$libopac ) ? $liblibrarian : $libopac;
736 $res->{$tag}->{$subfield}->{tab} = $tab;
737 $res->{$tag}->{$subfield}->{mandatory} = $mandatory;
738 $res->{$tag}->{$subfield}->{repeatable} = $repeatable;
739 $res->{$tag}->{$subfield}->{authorised_value} = $authorised_value;
740 $res->{$tag}->{$subfield}->{authtypecode} = $authtypecode;
741 $res->{$tag}->{$subfield}->{value_builder} = $value_builder;
742 $res->{$tag}->{$subfield}->{kohafield} = $kohafield;
743 $res->{$tag}->{$subfield}->{seealso} = $seealso;
744 $res->{$tag}->{$subfield}->{hidden} = $hidden;
745 $res->{$tag}->{$subfield}->{isurl} = $isurl;
746 $res->{$tag}->{$subfield}->{'link'} = $link;
747 $res->{$tag}->{$subfield}->{defaultvalue} = $defaultvalue;
750 $marc_structure_cache->{$forlibrarian}->{$frameworkcode} = $res;
755 =head2 GetUsedMarcStructure
757 the same function as GetMarcStructure expcet it just take field
758 in tab 0-9. (used field)
760 my $results = GetUsedMarcStructure($frameworkcode);
762 L<$results> is a ref to an array which each case containts a ref
763 to a hash which each keys is the columns from marc_subfield_structure
765 L<$frameworkcode> is the framework code.
769 sub GetUsedMarcStructure($){
770 my $frameworkcode = shift || '';
771 my $dbh = C4::Context->dbh;
774 FROM marc_subfield_structure
776 AND frameworkcode = ?
779 my $sth = $dbh->prepare($query);
780 $sth->execute($frameworkcode);
781 while (my $row = $sth->fetchrow_hashref){
787 =head2 GetMarcFromKohaField
791 ($MARCfield,$MARCsubfield)=GetMarcFromKohaField($kohafield,$frameworkcode);
792 Returns the MARC fields & subfields mapped to the koha field
793 for the given frameworkcode
799 sub GetMarcFromKohaField {
800 my ( $kohafield, $frameworkcode ) = @_;
801 return 0, 0 unless $kohafield;
802 my $relations = C4::Context->marcfromkohafield;
804 $relations->{$frameworkcode}->{$kohafield}->[0],
805 $relations->{$frameworkcode}->{$kohafield}->[1]
813 Returns MARC::Record of the biblionumber passed in parameter.
814 the marc record contains both biblio & item datas
821 my $biblionumber = shift;
822 my $dbh = C4::Context->dbh;
824 $dbh->prepare("SELECT marcxml FROM biblioitems WHERE biblionumber=? ");
825 $sth->execute($biblionumber);
826 my $row = $sth->fetchrow_hashref;
827 my $marcxml = StripNonXmlChars($row->{'marcxml'});
828 MARC::File::XML->default_record_format(C4::Context->preference('marcflavour'));
829 my $record = MARC::Record->new();
831 $record = eval {MARC::Record::new_from_xml( $marcxml, "utf8", C4::Context->preference('marcflavour'))};
832 if ($@) {warn " problem with :$biblionumber : $@ \n$marcxml";}
833 # $record = MARC::Record::new_from_usmarc( $marc) if $marc;
844 my $marcxml = GetXmlBiblio($biblionumber);
846 Returns biblioitems.marcxml of the biblionumber passed in parameter.
847 The XML contains both biblio & item datas
854 my ( $biblionumber ) = @_;
855 my $dbh = C4::Context->dbh;
857 $dbh->prepare("SELECT marcxml FROM biblioitems WHERE biblionumber=? ");
858 $sth->execute($biblionumber);
859 my ($marcxml) = $sth->fetchrow;
863 =head2 GetAuthorisedValueDesc
867 my $subfieldvalue =get_authorised_value_desc(
868 $tag, $subf[$i][0],$subf[$i][1], '', $taglib, $category);
869 Retrieve the complete description for a given authorised value.
871 Now takes $category and $value pair too.
872 my $auth_value_desc =GetAuthorisedValueDesc(
873 '','', 'DVD' ,'','','CCODE');
879 sub GetAuthorisedValueDesc {
880 my ( $tag, $subfield, $value, $framework, $tagslib, $category ) = @_;
881 my $dbh = C4::Context->dbh;
885 if ( $tagslib->{$tag}->{$subfield}->{'authorised_value'} eq "branches" ) {
886 return C4::Branch::GetBranchName($value);
890 if ( $tagslib->{$tag}->{$subfield}->{'authorised_value'} eq "itemtypes" ) {
891 return getitemtypeinfo($value)->{description};
894 #---- "true" authorized value
895 $category = $tagslib->{$tag}->{$subfield}->{'authorised_value'}
898 if ( $category ne "" ) {
901 "SELECT lib FROM authorised_values WHERE category = ? AND authorised_value = ?"
903 $sth->execute( $category, $value );
904 my $data = $sth->fetchrow_hashref;
905 return $data->{'lib'};
908 return $value; # if nothing is found return the original value
916 $marcnotesarray = GetMarcNotes( $record, $marcflavour );
917 Get all notes from the MARC record and returns them in an array.
918 The note are stored in differents places depending on MARC flavour
925 my ( $record, $marcflavour ) = @_;
927 if ( $marcflavour eq "MARC21" ) {
930 else { # assume unimarc if not marc21
937 foreach my $field ( $record->field($scope) ) {
938 my $value = $field->as_string();
940 $marcnote = { marcnote => $note, };
941 push @marcnotes, $marcnote;
944 if ( $note ne $value ) {
945 $note = $note . " " . $value;
950 $marcnote = { marcnote => $note };
951 push @marcnotes, $marcnote; #load last tag into array
956 =head2 GetMarcSubjects
960 $marcsubjcts = GetMarcSubjects($record,$marcflavour);
961 Get all subjects from the MARC record and returns them in an array.
962 The subjects are stored in differents places depending on MARC flavour
968 sub GetMarcSubjects {
969 my ( $record, $marcflavour ) = @_;
970 my ( $mintag, $maxtag );
971 if ( $marcflavour eq "MARC21" ) {
975 else { # assume unimarc if not marc21
985 foreach my $field ( $record->field('6..' )) {
986 next unless $field->tag() >= $mintag && $field->tag() <= $maxtag;
988 my @subfields = $field->subfields();
991 # if there is an authority link, build the link with an= subfield9
992 my $subfield9 = $field->subfield('9');
993 for my $subject_subfield (@subfields ) {
994 # don't load unimarc subfields 3,4,5
995 next if (($marcflavour eq "UNIMARC") and ($subject_subfield->[0] =~ (3|4|5) ) );
996 my $code = $subject_subfield->[0];
997 my $value = $subject_subfield->[1];
998 my $linkvalue = $value;
999 $linkvalue =~ s/(\(|\))//g;
1000 my $operator = " and " unless $counter==0;
1002 @link_loop = ({'limit' => 'an' ,link => "$subfield9" });
1004 push @link_loop, {'limit' => 'su', link => $linkvalue, operator => $operator };
1006 my $separator = C4::Context->preference("authoritysep") unless $counter==0;
1008 my @this_link_loop = @link_loop;
1009 push @subfields_loop, {code => $code, value => $value, link_loop => \@this_link_loop, separator => $separator} unless ($subject_subfield->[0] == 9 );
1013 push @marcsubjects, { MARCSUBJECT_SUBFIELDS_LOOP => \@subfields_loop };
1016 return \@marcsubjects;
1017 } #end getMARCsubjects
1019 =head2 GetMarcAuthors
1023 authors = GetMarcAuthors($record,$marcflavour);
1024 Get all authors from the MARC record and returns them in an array.
1025 The authors are stored in differents places depending on MARC flavour
1031 sub GetMarcAuthors {
1032 my ( $record, $marcflavour ) = @_;
1033 my ( $mintag, $maxtag );
1034 # tagslib useful for UNIMARC author reponsabilities
1035 my $tagslib = &GetMarcStructure( 1, '' ); # FIXME : we don't have the framework available, we take the default framework. May be bugguy on some setups, will be usually correct.
1036 if ( $marcflavour eq "MARC21" ) {
1040 elsif ( $marcflavour eq "UNIMARC" ) { # assume unimarc if not marc21
1049 foreach my $field ( $record->fields ) {
1050 next unless $field->tag() >= $mintag && $field->tag() <= $maxtag;
1053 my @subfields = $field->subfields();
1055 # if there is an authority link, build the link with Koha-Auth-Number: subfield9
1056 my $subfield9 = $field->subfield('9');
1057 for my $authors_subfield (@subfields) {
1058 # don't load unimarc subfields 3, 5
1059 next if ($marcflavour eq 'UNIMARC' and ($authors_subfield->[0] =~ (3|5) ) );
1060 my $subfieldcode = $authors_subfield->[0];
1061 my $value = $authors_subfield->[1];
1062 my $linkvalue = $value;
1063 $linkvalue =~ s/(\(|\))//g;
1064 my $operator = " and " unless $count_auth==0;
1065 # if we have an authority link, use that as the link, otherwise use standard searching
1067 @link_loop = ({'limit' => 'Koha-Auth-Number' ,link => "$subfield9" });
1070 # reset $linkvalue if UNIMARC author responsibility
1071 if ( $marcflavour eq 'UNIMARC' and ($authors_subfield->[0] eq "4")) {
1072 $linkvalue = "(".GetAuthorisedValueDesc( $field->tag(), $authors_subfield->[0], $authors_subfield->[1], '', $tagslib ).")";
1074 push @link_loop, {'limit' => 'au', link => $linkvalue, operator => $operator };
1076 $value = GetAuthorisedValueDesc( $field->tag(), $authors_subfield->[0], $authors_subfield->[1], '', $tagslib ) if ( $marcflavour eq 'UNIMARC' and ($authors_subfield->[0] =~/4/));
1077 my @this_link_loop = @link_loop;
1078 my $separator = C4::Context->preference("authoritysep") unless $count_auth==0;
1079 push @subfields_loop, {code => $subfieldcode, value => $value, link_loop => \@this_link_loop, separator => $separator} unless ($authors_subfield->[0] == 9 );
1082 push @marcauthors, { MARCAUTHOR_SUBFIELDS_LOOP => \@subfields_loop };
1084 return \@marcauthors;
1091 $marcurls = GetMarcUrls($record,$marcflavour);
1092 Returns arrayref of URLs from MARC data, suitable to pass to tmpl loop.
1093 Assumes web resources (not uncommon in MARC21 to omit resource type ind)
1100 my ($record, $marcflavour) = @_;
1103 for my $field ($record->field('856')) {
1104 my $url = $field->subfield('u');
1106 for my $note ( $field->subfield('z')) {
1107 push @notes , {note => $note};
1109 $marcurl = { MARCURL => $url,
1112 if($marcflavour eq 'MARC21') {
1113 my $s3 = $field->subfield('3');
1114 my $link = $field->subfield('y');
1115 $marcurl->{'linktext'} = $link || $s3 || $url ;;
1116 $marcurl->{'part'} = $s3 if($link);
1117 $marcurl->{'toc'} = 1 if($s3 =~ /^[Tt]able/) ;
1119 $marcurl->{'linktext'} = $url;
1121 push @marcurls, $marcurl;
1126 =head2 GetMarcSeries
1130 $marcseriesarray = GetMarcSeries($record,$marcflavour);
1131 Get all series from the MARC record and returns them in an array.
1132 The series are stored in differents places depending on MARC flavour
1139 my ($record, $marcflavour) = @_;
1140 my ($mintag, $maxtag);
1141 if ($marcflavour eq "MARC21") {
1144 } else { # assume unimarc if not marc21
1154 foreach my $field ($record->field('440'), $record->field('490')) {
1156 #my $value = $field->subfield('a');
1157 #$marcsubjct = {MARCSUBJCT => $value,};
1158 my @subfields = $field->subfields();
1159 #warn "subfields:".join " ", @$subfields;
1162 for my $series_subfield (@subfields) {
1164 undef $volume_number;
1165 # see if this is an instance of a volume
1166 if ($series_subfield->[0] eq 'v') {
1170 my $code = $series_subfield->[0];
1171 my $value = $series_subfield->[1];
1172 my $linkvalue = $value;
1173 $linkvalue =~ s/(\(|\))//g;
1174 my $operator = " and " unless $counter==0;
1175 push @link_loop, {link => $linkvalue, operator => $operator };
1176 my $separator = C4::Context->preference("authoritysep") unless $counter==0;
1177 if ($volume_number) {
1178 push @subfields_loop, {volumenum => $value};
1181 push @subfields_loop, {code => $code, value => $value, link_loop => \@link_loop, separator => $separator, volumenum => $volume_number};
1185 push @marcseries, { MARCSERIES_SUBFIELDS_LOOP => \@subfields_loop };
1186 #$marcsubjct = {MARCSUBJCT => $field->as_string(),};
1187 #push @marcsubjcts, $marcsubjct;
1191 my $marcseriessarray=\@marcseries;
1192 return $marcseriessarray;
1193 } #end getMARCseriess
1195 =head2 GetFrameworkCode
1199 $frameworkcode = GetFrameworkCode( $biblionumber )
1205 sub GetFrameworkCode {
1206 my ( $biblionumber ) = @_;
1207 my $dbh = C4::Context->dbh;
1208 my $sth = $dbh->prepare("SELECT frameworkcode FROM biblio WHERE biblionumber=?");
1209 $sth->execute($biblionumber);
1210 my ($frameworkcode) = $sth->fetchrow;
1211 return $frameworkcode;
1214 =head2 GetPublisherNameFromIsbn
1216 $name = GetPublishercodeFromIsbn($isbn);
1223 sub GetPublisherNameFromIsbn($){
1225 $isbn =~ s/[- _]//g;
1227 my @codes = (split '-', DisplayISBN($isbn));
1228 my $code = $codes[0].$codes[1].$codes[2];
1229 my $dbh = C4::Context->dbh;
1231 SELECT distinct publishercode
1234 AND publishercode IS NOT NULL
1237 my $sth = $dbh->prepare($query);
1238 $sth->execute("$code%");
1239 my $name = $sth->fetchrow;
1240 return $name if length $name;
1244 =head2 TransformKohaToMarc
1248 $record = TransformKohaToMarc( $hash )
1249 This function builds partial MARC::Record from a hash
1250 Hash entries can be from biblio or biblioitems.
1251 This function is called in acquisition module, to create a basic catalogue entry from user entry
1257 sub TransformKohaToMarc {
1260 my $dbh = C4::Context->dbh;
1263 "SELECT tagfield,tagsubfield FROM marc_subfield_structure WHERE frameworkcode=? AND kohafield=?"
1265 my $record = MARC::Record->new();
1266 foreach (keys %{$hash}) {
1267 &TransformKohaToMarcOneField( $sth, $record, $_,
1273 =head2 TransformKohaToMarcOneField
1277 $record = TransformKohaToMarcOneField( $sth, $record, $kohafieldname, $value, $frameworkcode );
1283 sub TransformKohaToMarcOneField {
1284 my ( $sth, $record, $kohafieldname, $value, $frameworkcode ) = @_;
1285 $frameworkcode='' unless $frameworkcode;
1289 if ( !defined $sth ) {
1290 my $dbh = C4::Context->dbh;
1291 $sth = $dbh->prepare(
1292 "SELECT tagfield,tagsubfield FROM marc_subfield_structure WHERE frameworkcode=? AND kohafield=?"
1295 $sth->execute( $frameworkcode, $kohafieldname );
1296 if ( ( $tagfield, $tagsubfield ) = $sth->fetchrow ) {
1297 my $tag = $record->field($tagfield);
1299 $tag->update( $tagsubfield => $value );
1300 $record->delete_field($tag);
1301 $record->insert_fields_ordered($tag);
1304 $record->add_fields( $tagfield, " ", " ", $tagsubfield => $value );
1310 =head2 TransformHtmlToXml
1314 $xml = TransformHtmlToXml( $tags, $subfields, $values, $indicator, $ind_tag, $auth_type )
1316 $auth_type contains :
1317 - nothing : rebuild a biblio, un UNIMARC the encoding is in 100$a pos 26/27
1318 - UNIMARCAUTH : rebuild an authority. In UNIMARC, the encoding is in 100$a pos 13/14
1319 - ITEM : rebuild an item : in UNIMARC, 100$a, it's in the biblio ! (otherwise, we would get 2 100 fields !)
1325 sub TransformHtmlToXml {
1326 my ( $tags, $subfields, $values, $indicator, $ind_tag, $auth_type ) = @_;
1327 my $xml = MARC::File::XML::header('UTF-8');
1328 $auth_type = C4::Context->preference('marcflavour') unless $auth_type;
1329 MARC::File::XML->default_record_format($auth_type);
1330 # in UNIMARC, field 100 contains the encoding
1331 # check that there is one, otherwise the
1332 # MARC::Record->new_from_xml will fail (and Koha will die)
1333 my $unimarc_and_100_exist=0;
1334 $unimarc_and_100_exist=1 if $auth_type eq 'ITEM'; # if we rebuild an item, no need of a 100 field
1339 for ( my $i = 0 ; $i <= @$tags ; $i++ ) {
1340 if (C4::Context->preference('marcflavour') eq 'UNIMARC' and @$tags[$i] eq "100" and @$subfields[$i] eq "a") {
1341 # if we have a 100 field and it's values are not correct, skip them.
1342 # if we don't have any valid 100 field, we will create a default one at the end
1343 my $enc = substr( @$values[$i], 26, 2 );
1344 if ($enc eq '01' or $enc eq '50' or $enc eq '03') {
1345 $unimarc_and_100_exist=1;
1350 @$values[$i] =~ s/&/&/g;
1351 @$values[$i] =~ s/</</g;
1352 @$values[$i] =~ s/>/>/g;
1353 @$values[$i] =~ s/"/"/g;
1354 @$values[$i] =~ s/'/'/g;
1355 # if ( !utf8::is_utf8( @$values[$i] ) ) {
1356 # utf8::decode( @$values[$i] );
1358 if ( ( @$tags[$i] ne $prevtag ) ) {
1359 $j++ unless ( @$tags[$i] eq "" );
1361 $xml .= "</datafield>\n";
1362 if ( ( @$tags[$i] && @$tags[$i] > 10 )
1363 && ( @$values[$i] ne "" ) )
1365 my $ind1 = substr( @$indicator[$j], 0, 1 );
1367 if ( @$indicator[$j] ) {
1368 $ind2 = substr( @$indicator[$j], 1, 1 );
1371 warn "Indicator in @$tags[$i] is empty";
1375 "<datafield tag=\"@$tags[$i]\" ind1=\"$ind1\" ind2=\"$ind2\">\n";
1377 "<subfield code=\"@$subfields[$i]\">@$values[$i]</subfield>\n";
1385 if ( @$values[$i] ne "" ) {
1388 if ( @$tags[$i] eq "000" ) {
1389 $xml .= "<leader>@$values[$i]</leader>\n";
1392 # rest of the fixed fields
1394 elsif ( @$tags[$i] < 10 ) {
1396 "<controlfield tag=\"@$tags[$i]\">@$values[$i]</controlfield>\n";
1400 my $ind1 = substr( @$indicator[$j], 0, 1 );
1401 my $ind2 = substr( @$indicator[$j], 1, 1 );
1403 "<datafield tag=\"@$tags[$i]\" ind1=\"$ind1\" ind2=\"$ind2\">\n";
1405 "<subfield code=\"@$subfields[$i]\">@$values[$i]</subfield>\n";
1411 else { # @$tags[$i] eq $prevtag
1412 if ( @$values[$i] eq "" ) {
1416 my $ind1 = substr( @$indicator[$j], 0, 1 );
1417 my $ind2 = substr( @$indicator[$j], 1, 1 );
1419 "<datafield tag=\"@$tags[$i]\" ind1=\"$ind1\" ind2=\"$ind2\">\n";
1423 "<subfield code=\"@$subfields[$i]\">@$values[$i]</subfield>\n";
1426 $prevtag = @$tags[$i];
1428 if (C4::Context->preference('marcflavour') eq 'UNIMARC' and !$unimarc_and_100_exist) {
1429 # warn "SETTING 100 for $auth_type";
1430 use POSIX qw(strftime);
1431 my $string = strftime( "%Y%m%d", localtime(time) );
1432 # set 50 to position 26 is biblios, 13 if authorities
1434 $pos=13 if $auth_type eq 'UNIMARCAUTH';
1435 $string = sprintf( "%-*s", 35, $string );
1436 substr( $string, $pos , 6, "50" );
1437 $xml .= "<datafield tag=\"100\" ind1=\"\" ind2=\"\">\n";
1438 $xml .= "<subfield code=\"a\">$string</subfield>\n";
1439 $xml .= "</datafield>\n";
1441 $xml .= MARC::File::XML::footer();
1445 =head2 TransformHtmlToMarc
1447 L<$record> = TransformHtmlToMarc(L<$params>,L<$cgi>)
1448 L<$params> is a ref to an array as below:
1450 'tag_010_indicator_531951' ,
1451 'tag_010_code_a_531951_145735' ,
1452 'tag_010_subfield_a_531951_145735' ,
1453 'tag_200_indicator_873510' ,
1454 'tag_200_code_a_873510_673465' ,
1455 'tag_200_subfield_a_873510_673465' ,
1456 'tag_200_code_b_873510_704318' ,
1457 'tag_200_subfield_b_873510_704318' ,
1458 'tag_200_code_e_873510_280822' ,
1459 'tag_200_subfield_e_873510_280822' ,
1460 'tag_200_code_f_873510_110730' ,
1461 'tag_200_subfield_f_873510_110730' ,
1463 L<$cgi> is the CGI object which containts the value.
1464 L<$record> is the MARC::Record object.
1468 sub TransformHtmlToMarc {
1472 # creating a new record
1473 my $record = MARC::Record->new();
1476 while ($params->[$i]){ # browse all CGI params
1477 my $param = $params->[$i];
1479 # if we are on biblionumber, store it in the MARC::Record (it may not be in the edited fields)
1480 if ($param eq 'biblionumber') {
1481 my ( $biblionumbertagfield, $biblionumbertagsubfield ) =
1482 &GetMarcFromKohaField( "biblio.biblionumber", '' );
1483 if ($biblionumbertagfield < 10) {
1484 $newfield = MARC::Field->new(
1485 $biblionumbertagfield,
1486 $cgi->param($param),
1489 $newfield = MARC::Field->new(
1490 $biblionumbertagfield,
1493 "$biblionumbertagsubfield" => $cgi->param($param),
1496 push @fields,$newfield if($newfield);
1498 elsif ($param =~ /^tag_(\d*)_indicator_/){ # new field start when having 'input name="..._indicator_..."
1501 my $ind1 = substr($cgi->param($param),0,1);
1502 my $ind2 = substr($cgi->param($param),1,1);
1506 if($tag < 10){ # no code for theses fields
1507 # in MARC editor, 000 contains the leader.
1508 if ($tag eq '000' ) {
1509 $record->leader($cgi->param($params->[$j+1])) if length($cgi->param($params->[$j+1]))==24;
1510 # between 001 and 009 (included)
1512 $newfield = MARC::Field->new(
1514 $cgi->param($params->[$j+1]),
1517 # > 009, deal with subfields
1519 while($params->[$j] =~ /_code_/){ # browse all it's subfield
1520 my $inner_param = $params->[$j];
1522 if($cgi->param($params->[$j+1])){ # only if there is a value (code => value)
1523 $newfield->add_subfields(
1524 $cgi->param($inner_param) => $cgi->param($params->[$j+1])
1528 if ( $cgi->param($params->[$j+1]) ) { # creating only if there is a value (code => value)
1529 $newfield = MARC::Field->new(
1533 $cgi->param($inner_param) => $cgi->param($params->[$j+1]),
1540 push @fields,$newfield if($newfield);
1545 $record->append_fields(@fields);
1549 # cache inverted MARC field map
1550 our $inverted_field_map;
1552 =head2 TransformMarcToKoha
1556 $result = TransformMarcToKoha( $dbh, $record, $frameworkcode )
1560 Extract data from a MARC bib record into a hashref representing
1561 Koha biblio, biblioitems, and items fields.
1564 sub TransformMarcToKoha {
1565 my ( $dbh, $record, $frameworkcode, $limit_table ) = @_;
1569 unless (defined $inverted_field_map) {
1570 $inverted_field_map = _get_inverted_marc_field_map();
1574 if ($limit_table eq 'items') {
1575 $tables{'items'} = 1;
1577 $tables{'items'} = 1;
1578 $tables{'biblio'} = 1;
1579 $tables{'biblioitems'} = 1;
1582 # traverse through record
1583 MARCFIELD: foreach my $field ($record->fields()) {
1584 my $tag = $field->tag();
1585 next MARCFIELD unless exists $inverted_field_map->{$frameworkcode}->{$tag};
1586 if ($field->is_control_field()) {
1587 my $kohafields = $inverted_field_map->{$frameworkcode}->{$tag}->{list};
1588 ENTRY: foreach my $entry (@{ $kohafields }) {
1589 my ($subfield, $table, $column) = @{ $entry };
1590 next ENTRY unless exists $tables{$table};
1591 my $key = _disambiguate($table, $column);
1592 if ($result->{$key}) {
1593 unless (($key eq "biblionumber" or $key eq "biblioitemnumber") and ($field->data() eq "")) {
1594 $result->{$key} .= " | " . $field->data();
1597 $result->{$key} = $field->data();
1601 # deal with subfields
1602 MARCSUBFIELD: foreach my $sf ($field->subfields()) {
1603 my $code = $sf->[0];
1604 next MARCSUBFIELD unless exists $inverted_field_map->{$frameworkcode}->{$tag}->{sfs}->{$code};
1605 my $value = $sf->[1];
1606 SFENTRY: foreach my $entry (@{ $inverted_field_map->{$frameworkcode}->{$tag}->{sfs}->{$code} }) {
1607 my ($table, $column) = @{ $entry };
1608 next SFENTRY unless exists $tables{$table};
1609 my $key = _disambiguate($table, $column);
1610 if ($result->{$key}) {
1611 unless (($key eq "biblionumber" or $key eq "biblioitemnumber") and ($value eq "")) {
1612 $result->{$key} .= " | " . $value;
1615 $result->{$key} = $value;
1622 # modify copyrightdate to keep only the 1st year found
1623 if (exists $result->{'copyrightdate'}) {
1624 my $temp = $result->{'copyrightdate'};
1625 $temp =~ m/c(\d\d\d\d)/; # search cYYYY first
1627 $result->{'copyrightdate'} = $1;
1629 else { # if no cYYYY, get the 1st date.
1630 $temp =~ m/(\d\d\d\d)/;
1631 $result->{'copyrightdate'} = $1;
1635 # modify publicationyear to keep only the 1st year found
1636 if (exists $result->{'publicationyear'}) {
1637 my $temp = $result->{'publicationyear'};
1638 $temp =~ m/c(\d\d\d\d)/; # search cYYYY first
1640 $result->{'publicationyear'} = $1;
1642 else { # if no cYYYY, get the 1st date.
1643 $temp =~ m/(\d\d\d\d)/;
1644 $result->{'publicationyear'} = $1;
1651 sub _get_inverted_marc_field_map {
1653 my $relations = C4::Context->marcfromkohafield;
1655 foreach my $frameworkcode (keys %{ $relations }) {
1656 foreach my $kohafield (keys %{ $relations->{$frameworkcode} }) {
1657 my $tag = $relations->{$frameworkcode}->{$kohafield}->[0];
1658 my $subfield = $relations->{$frameworkcode}->{$kohafield}->[1];
1659 my ($table, $column) = split /[.]/, $kohafield, 2;
1660 push @{ $field_map->{$frameworkcode}->{$tag}->{list} }, [ $subfield, $table, $column ];
1661 push @{ $field_map->{$frameworkcode}->{$tag}->{sfs}->{$subfield} }, [ $table, $column ];
1667 =head2 _disambiguate
1671 $newkey = _disambiguate($table, $field);
1673 This is a temporary hack to distinguish between the
1674 following sets of columns when using TransformMarcToKoha.
1676 items.cn_source & biblioitems.cn_source
1677 items.cn_sort & biblioitems.cn_sort
1679 Columns that are currently NOT distinguished (FIXME
1680 due to lack of time to fully test) are:
1682 biblio.notes and biblioitems.notes
1687 FIXME - this is necessary because prefixing each column
1688 name with the table name would require changing lots
1689 of code and templates, and exposing more of the DB
1690 structure than is good to the UI templates, particularly
1691 since biblio and bibloitems may well merge in a future
1692 version. In the future, it would also be good to
1693 separate DB access and UI presentation field names
1701 my ($table, $column) = @_;
1702 if ($column eq "cn_sort" or $column eq "cn_source") {
1703 return $table . '.' . $column;
1710 =head2 get_koha_field_from_marc
1714 $result->{_disambiguate($table, $field)} = get_koha_field_from_marc($table,$field,$record,$frameworkcode);
1716 Internal function to map data from the MARC record to a specific non-MARC field.
1717 FIXME: this is meant to replace TransformMarcToKohaOneField after more testing.
1723 sub get_koha_field_from_marc {
1724 my ($koha_table,$koha_column,$record,$frameworkcode) = @_;
1725 my ( $tagfield, $subfield ) = GetMarcFromKohaField( $koha_table.'.'.$koha_column, $frameworkcode );
1727 foreach my $field ( $record->field($tagfield) ) {
1728 if ( $field->tag() < 10 ) {
1730 $kohafield .= " | " . $field->data();
1733 $kohafield = $field->data();
1737 if ( $field->subfields ) {
1738 my @subfields = $field->subfields();
1739 foreach my $subfieldcount ( 0 .. $#subfields ) {
1740 if ( $subfields[$subfieldcount][0] eq $subfield ) {
1743 " | " . $subfields[$subfieldcount][1];
1747 $subfields[$subfieldcount][1];
1758 =head2 TransformMarcToKohaOneField
1762 $result = TransformMarcToKohaOneField( $kohatable, $kohafield, $record, $result, $frameworkcode )
1768 sub TransformMarcToKohaOneField {
1770 # FIXME ? if a field has a repeatable subfield that is used in old-db,
1771 # only the 1st will be retrieved...
1772 my ( $kohatable, $kohafield, $record, $result, $frameworkcode ) = @_;
1774 my ( $tagfield, $subfield ) =
1775 GetMarcFromKohaField( $kohatable . "." . $kohafield,
1777 foreach my $field ( $record->field($tagfield) ) {
1778 if ( $field->tag() < 10 ) {
1779 if ( $result->{$kohafield} ) {
1780 $result->{$kohafield} .= " | " . $field->data();
1783 $result->{$kohafield} = $field->data();
1787 if ( $field->subfields ) {
1788 my @subfields = $field->subfields();
1789 foreach my $subfieldcount ( 0 .. $#subfields ) {
1790 if ( $subfields[$subfieldcount][0] eq $subfield ) {
1791 if ( $result->{$kohafield} ) {
1792 $result->{$kohafield} .=
1793 " | " . $subfields[$subfieldcount][1];
1796 $result->{$kohafield} =
1797 $subfields[$subfieldcount][1];
1807 =head1 OTHER FUNCTIONS
1810 =head2 PrepareItemrecordDisplay
1814 PrepareItemrecordDisplay($itemrecord,$bibnum,$itemumber);
1816 Returns a hash with all the fields for Display a given item data in a template
1822 sub PrepareItemrecordDisplay {
1824 my ( $bibnum, $itemnum ) = @_;
1826 my $dbh = C4::Context->dbh;
1827 my $frameworkcode = &GetFrameworkCode( $bibnum );
1828 my ( $itemtagfield, $itemtagsubfield ) =
1829 &GetMarcFromKohaField( "items.itemnumber", $frameworkcode );
1830 my $tagslib = &GetMarcStructure( 1, $frameworkcode );
1831 my $itemrecord = C4::Items::GetMarcItem( $bibnum, $itemnum) if ($itemnum);
1833 my $authorised_values_sth =
1835 "SELECT authorised_value,lib FROM authorised_values WHERE category=? ORDER BY lib"
1837 foreach my $tag ( sort keys %{$tagslib} ) {
1838 my $previous_tag = '';
1840 # loop through each subfield
1842 foreach my $subfield ( sort keys %{ $tagslib->{$tag} } ) {
1843 next if ( subfield_is_koha_internal_p($subfield) );
1844 next if ( $tagslib->{$tag}->{$subfield}->{'tab'} ne "10" );
1846 $subfield_data{tag} = $tag;
1847 $subfield_data{subfield} = $subfield;
1848 $subfield_data{countsubfield} = $cntsubf++;
1849 $subfield_data{kohafield} =
1850 $tagslib->{$tag}->{$subfield}->{'kohafield'};
1852 # $subfield_data{marc_lib}=$tagslib->{$tag}->{$subfield}->{lib};
1853 $subfield_data{marc_lib} =
1854 "<span id=\"error\" title=\""
1855 . $tagslib->{$tag}->{$subfield}->{lib} . "\">"
1856 . substr( $tagslib->{$tag}->{$subfield}->{lib}, 0, 12 )
1858 $subfield_data{mandatory} =
1859 $tagslib->{$tag}->{$subfield}->{mandatory};
1860 $subfield_data{repeatable} =
1861 $tagslib->{$tag}->{$subfield}->{repeatable};
1862 $subfield_data{hidden} = "display:none"
1863 if $tagslib->{$tag}->{$subfield}->{hidden};
1865 ( $x, $value ) = _find_value( $tag, $subfield, $itemrecord )
1867 $value =~ s/"/"/g;
1869 # search for itemcallnumber if applicable
1870 if ( $tagslib->{$tag}->{$subfield}->{kohafield} eq
1871 'items.itemcallnumber'
1872 && C4::Context->preference('itemcallnumber') )
1875 substr( C4::Context->preference('itemcallnumber'), 0, 3 );
1877 substr( C4::Context->preference('itemcallnumber'), 3, 1 );
1878 my $temp = $itemrecord->field($CNtag) if ($itemrecord);
1880 $value = $temp->subfield($CNsubfield);
1883 if ( $tagslib->{$tag}->{$subfield}->{authorised_value} ) {
1884 my @authorised_values;
1887 # builds list, depending on authorised value...
1889 if ( $tagslib->{$tag}->{$subfield}->{'authorised_value'} eq
1892 if ( ( C4::Context->preference("IndependantBranches") )
1893 && ( C4::Context->userenv->{flags} != 1 ) )
1897 "SELECT branchcode,branchname FROM branches WHERE branchcode = ? ORDER BY branchname"
1899 $sth->execute( C4::Context->userenv->{branch} );
1900 push @authorised_values, ""
1902 $tagslib->{$tag}->{$subfield}->{mandatory} );
1903 while ( my ( $branchcode, $branchname ) =
1904 $sth->fetchrow_array )
1906 push @authorised_values, $branchcode;
1907 $authorised_lib{$branchcode} = $branchname;
1913 "SELECT branchcode,branchname FROM branches ORDER BY branchname"
1916 push @authorised_values, ""
1918 $tagslib->{$tag}->{$subfield}->{mandatory} );
1919 while ( my ( $branchcode, $branchname ) =
1920 $sth->fetchrow_array )
1922 push @authorised_values, $branchcode;
1923 $authorised_lib{$branchcode} = $branchname;
1929 elsif ( $tagslib->{$tag}->{$subfield}->{authorised_value} eq
1934 "SELECT itemtype,description FROM itemtypes ORDER BY description"
1937 push @authorised_values, ""
1938 unless ( $tagslib->{$tag}->{$subfield}->{mandatory} );
1939 while ( my ( $itemtype, $description ) =
1940 $sth->fetchrow_array )
1942 push @authorised_values, $itemtype;
1943 $authorised_lib{$itemtype} = $description;
1946 #---- "true" authorised value
1949 $authorised_values_sth->execute(
1950 $tagslib->{$tag}->{$subfield}->{authorised_value} );
1951 push @authorised_values, ""
1952 unless ( $tagslib->{$tag}->{$subfield}->{mandatory} );
1953 while ( my ( $value, $lib ) =
1954 $authorised_values_sth->fetchrow_array )
1956 push @authorised_values, $value;
1957 $authorised_lib{$value} = $lib;
1960 $subfield_data{marc_value} = CGI::scrolling_list(
1961 -name => 'field_value',
1962 -values => \@authorised_values,
1963 -default => "$value",
1964 -labels => \%authorised_lib,
1970 elsif ( $tagslib->{$tag}->{$subfield}->{thesaurus_category} ) {
1971 $subfield_data{marc_value} =
1972 "<input type=\"text\" name=\"field_value\" size=47 maxlength=255> <a href=\"javascript:Dopop('cataloguing/thesaurus_popup.pl?category=$tagslib->{$tag}->{$subfield}->{thesaurus_category}&index=',)\">...</a>";
1975 # COMMENTED OUT because No $i is provided with this API.
1976 # And thus, no value_builder can be activated.
1977 # BUT could be thought over.
1978 # } elsif ($tagslib->{$tag}->{$subfield}->{'value_builder'}) {
1979 # my $plugin="value_builder/".$tagslib->{$tag}->{$subfield}->{'value_builder'};
1981 # my $extended_param = plugin_parameters($dbh,$itemrecord,$tagslib,$i,0);
1982 # my ($function_name,$javascript) = plugin_javascript($dbh,$record,$tagslib,$i,0);
1983 # $subfield_data{marc_value}="<input type=\"text\" value=\"$value\" name=\"field_value\" size=47 maxlength=255 DISABLE READONLY OnFocus=\"javascript:Focus$function_name()\" OnBlur=\"javascript:Blur$function_name()\"> <a href=\"javascript:Clic$function_name()\">...</a> $javascript";
1986 $subfield_data{marc_value} =
1987 "<input type=\"text\" name=\"field_value\" value=\"$value\" size=50 maxlength=255>";
1989 push( @loop_data, \%subfield_data );
1993 my $itemnumber = $itemrecord->subfield( $itemtagfield, $itemtagsubfield )
1994 if ( $itemrecord && $itemrecord->field($itemtagfield) );
1996 'itemtagfield' => $itemtagfield,
1997 'itemtagsubfield' => $itemtagsubfield,
1998 'itemnumber' => $itemnumber,
1999 'iteminformation' => \@loop_data
2005 # true ModZebra commented until indexdata fixes zebraDB crashes (it seems they occur on multiple updates
2007 # replaced by a zebraqueue table, that is filled with ModZebra to run.
2008 # the table is emptied by misc/cronjobs/zebraqueue_start.pl script
2009 # =head2 ModZebrafiles
2011 # &ModZebrafiles( $dbh, $biblionumber, $record, $folder, $server );
2015 # sub ModZebrafiles {
2017 # my ( $dbh, $biblionumber, $record, $folder, $server ) = @_;
2021 # C4::Context->zebraconfig($server)->{directory} . "/" . $folder . "/";
2022 # unless ( opendir( DIR, "$zebradir" ) ) {
2023 # warn "$zebradir not found";
2027 # my $filename = $zebradir . $biblionumber;
2030 # open( OUTPUT, ">", $filename . ".xml" );
2031 # print OUTPUT $record;
2040 ModZebra( $biblionumber, $op, $server, $newRecord );
2042 $biblionumber is the biblionumber we want to index
2043 $op is specialUpdate or delete, and is used to know what we want to do
2044 $server is the server that we want to update
2045 $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.
2052 ###Accepts a $server variable thus we can use it for biblios authorities or other zebra dbs
2053 my ( $biblionumber, $op, $server, $newRecord ) = @_;
2054 my $dbh=C4::Context->dbh;
2056 # true ModZebra commented until indexdata fixes zebraDB crashes (it seems they occur on multiple updates
2058 # replaced by a zebraqueue table, that is filled with ModZebra to run.
2059 # the table is emptied by misc/cronjobs/zebraqueue_start.pl script
2061 if (C4::Context->preference("NoZebra")) {
2062 # lock the nozebra table : we will read index lines, update them in Perl process
2063 # and write everything in 1 transaction.
2064 # lock the table to avoid someone else overwriting what we are doing
2065 $dbh->do('LOCK TABLES nozebra WRITE,biblio WRITE,biblioitems WRITE, systempreferences WRITE, auth_types WRITE, auth_header WRITE');
2066 my %result; # the result hash that will be builded by deletion / add, and written on mySQL at the end, to improve speed
2068 if ($server eq 'biblioserver') {
2069 $record= GetMarcBiblio($biblionumber);
2071 $record= C4::AuthoritiesMarc::GetAuthority($biblionumber);
2073 if ($op eq 'specialUpdate') {
2074 # OK, we have to add or update the record
2075 # 1st delete (virtually, in indexes), if record actually exists
2077 %result = _DelBiblioNoZebra($biblionumber,$record,$server);
2079 # ... add the record
2080 %result=_AddBiblioNoZebra($biblionumber,$newRecord, $server, %result);
2082 # it's a deletion, delete the record...
2083 # warn "DELETE the record $biblionumber on $server".$record->as_formatted;
2084 %result=_DelBiblioNoZebra($biblionumber,$record,$server);
2086 # ok, now update the database...
2087 my $sth = $dbh->prepare("UPDATE nozebra SET biblionumbers=? WHERE server=? AND indexname=? AND value=?");
2088 foreach my $key (keys %result) {
2089 foreach my $index (keys %{$result{$key}}) {
2090 $sth->execute($result{$key}->{$index}, $server, $key, $index);
2093 $dbh->do('UNLOCK TABLES');
2097 # we use zebra, just fill zebraqueue table
2099 my $sth=$dbh->prepare("INSERT INTO zebraqueue (biblio_auth_number,server,operation) VALUES(?,?,?)");
2100 $sth->execute($biblionumber,$server,$op);
2105 =head2 GetNoZebraIndexes
2107 %indexes = GetNoZebraIndexes;
2109 return the data from NoZebraIndexes syspref.
2113 sub GetNoZebraIndexes {
2114 my $index = C4::Context->preference('NoZebraIndexes');
2116 foreach my $line (split /('|"),/,$index) {
2117 $line =~ /(.*)=>(.*)/;
2118 my $index = substr($1,1); # get the index, don't forget to remove initial ' or "
2120 $index =~ s/'|"|\s//g;
2123 $fields =~ s/'|"|\s//g;
2124 $indexes{$index}=$fields;
2129 =head1 INTERNAL FUNCTIONS
2131 =head2 _DelBiblioNoZebra($biblionumber,$record,$server);
2133 function to delete a biblio in NoZebra indexes
2134 This function does NOT delete anything in database : it reads all the indexes entries
2135 that have to be deleted & delete them in the hash
2136 The SQL part is done either :
2137 - after the Add if we are modifying a biblio (delete + add again)
2138 - immediatly after this sub if we are doing a true deletion.
2139 $server can be 'biblioserver' or 'authorityserver' : it indexes biblios or authorities (in the same table, $server being part of the table itself
2144 sub _DelBiblioNoZebra {
2145 my ($biblionumber, $record, $server)=@_;
2148 my $dbh = C4::Context->dbh;
2152 if ($server eq 'biblioserver') {
2153 %index=GetNoZebraIndexes;
2154 # get title of the record (to store the 10 first letters with the index)
2155 my ($titletag,$titlesubfield) = GetMarcFromKohaField('biblio.title');
2156 $title = lc($record->subfield($titletag,$titlesubfield));
2158 # for authorities, the "title" is the $a mainentry
2159 my $authref = C4::AuthoritiesMarc::GetAuthType($record->subfield(152,'b'));
2160 warn "ERROR : authtype undefined for ".$record->as_formatted unless $authref;
2161 $title = $record->subfield($authref->{auth_tag_to_report},'a');
2162 $index{'mainmainentry'}= $authref->{'auth_tag_to_report'}.'a';
2163 $index{'mainentry'} = $authref->{'auth_tag_to_report'}.'*';
2164 $index{'auth_type'} = '152b';
2168 # remove blancks comma (that could cause problem when decoding the string for CQL retrieval) and regexp specific values
2169 $title =~ s/ |,|;|\[|\]|\(|\)|\*|-|'|=//g;
2170 # limit to 10 char, should be enough, and limit the DB size
2171 $title = substr($title,0,10);
2173 my $sth2=$dbh->prepare('SELECT biblionumbers FROM nozebra WHERE server=? AND indexname=? AND value=?');
2174 foreach my $field ($record->fields()) {
2175 #parse each subfield
2176 next if $field->tag <10;
2177 foreach my $subfield ($field->subfields()) {
2178 my $tag = $field->tag();
2179 my $subfieldcode = $subfield->[0];
2181 # check each index to see if the subfield is stored somewhere
2182 # otherwise, store it in __RAW__ index
2183 foreach my $key (keys %index) {
2184 # warn "examining $key index : ".$index{$key}." for $tag $subfieldcode";
2185 if ($index{$key} =~ /$tag\*/ or $index{$key} =~ /$tag$subfieldcode/) {
2187 my $line= lc $subfield->[1];
2188 # remove meaningless value in the field...
2189 $line =~ s/-|\.|\?|,|;|!|'|\(|\)|\[|\]|{|}|"|<|>|&|\+|\*|\/|=|:/ /g;
2190 # ... and split in words
2191 foreach (split / /,$line) {
2192 next unless $_; # skip empty values (multiple spaces)
2193 # if the entry is already here, do nothing, the biblionumber has already be removed
2194 unless ($result{$key}->{$_} =~ /$biblionumber,$title\-(\d);/) {
2195 # get the index value if it exist in the nozebra table and remove the entry, otherwise, do nothing
2196 $sth2->execute($server,$key,$_);
2197 my $existing_biblionumbers = $sth2->fetchrow;
2199 if ($existing_biblionumbers) {
2200 # warn " existing for $key $_: $existing_biblionumbers";
2201 $result{$key}->{$_} =$existing_biblionumbers;
2202 $result{$key}->{$_} =~ s/$biblionumber,$title\-(\d);//;
2208 # the subfield is not indexed, store it in __RAW__ index anyway
2210 my $line= lc $subfield->[1];
2211 $line =~ s/-|\.|\?|,|;|!|'|\(|\)|\[|\]|{|}|"|<|>|&|\+|\*|\/|=|:/ /g;
2212 # ... and split in words
2213 foreach (split / /,$line) {
2214 next unless $_; # skip empty values (multiple spaces)
2215 # if the entry is already here, do nothing, the biblionumber has already be removed
2216 unless ($result{'__RAW__'}->{$_} =~ /$biblionumber,$title\-(\d);/) {
2217 # get the index value if it exist in the nozebra table and remove the entry, otherwise, do nothing
2218 $sth2->execute($server,'__RAW__',$_);
2219 my $existing_biblionumbers = $sth2->fetchrow;
2221 if ($existing_biblionumbers) {
2222 $result{'__RAW__'}->{$_} =$existing_biblionumbers;
2223 $result{'__RAW__'}->{$_} =~ s/$biblionumber,$title\-(\d);//;
2233 =head2 _AddBiblioNoZebra($biblionumber, $record, $server, %result);
2235 function to add a biblio in NoZebra indexes
2239 sub _AddBiblioNoZebra {
2240 my ($biblionumber, $record, $server, %result)=@_;
2241 my $dbh = C4::Context->dbh;
2245 if ($server eq 'biblioserver') {
2246 %index=GetNoZebraIndexes;
2247 # get title of the record (to store the 10 first letters with the index)
2248 my ($titletag,$titlesubfield) = GetMarcFromKohaField('biblio.title');
2249 $title = lc($record->subfield($titletag,$titlesubfield));
2251 # warn "server : $server";
2252 # for authorities, the "title" is the $a mainentry
2253 my $authref = C4::AuthoritiesMarc::GetAuthType($record->subfield(152,'b'));
2254 warn "ERROR : authtype undefined for ".$record->as_formatted unless $authref;
2255 $title = $record->subfield($authref->{auth_tag_to_report},'a');
2256 $index{'mainmainentry'} = $authref->{auth_tag_to_report}.'a';
2257 $index{'mainentry'} = $authref->{auth_tag_to_report}.'*';
2258 $index{'auth_type'} = '152b';
2261 # remove blancks comma (that could cause problem when decoding the string for CQL retrieval) and regexp specific values
2262 $title =~ s/ |,|;|\[|\]|\(|\)|\*|-|'|=//g;
2263 # limit to 10 char, should be enough, and limit the DB size
2264 $title = substr($title,0,10);
2266 my $sth2=$dbh->prepare('SELECT biblionumbers FROM nozebra WHERE server=? AND indexname=? AND value=?');
2267 foreach my $field ($record->fields()) {
2268 #parse each subfield
2269 next if $field->tag <10;
2270 foreach my $subfield ($field->subfields()) {
2271 my $tag = $field->tag();
2272 my $subfieldcode = $subfield->[0];
2274 # check each index to see if the subfield is stored somewhere
2275 # otherwise, store it in __RAW__ index
2276 foreach my $key (keys %index) {
2277 # warn "examining $key index : ".$index{$key}." for $tag $subfieldcode";
2278 if ($index{$key} =~ /$tag\*/ or $index{$key} =~ /$tag$subfieldcode/) {
2280 my $line= lc $subfield->[1];
2281 # remove meaningless value in the field...
2282 $line =~ s/-|\.|\?|,|;|!|'|\(|\)|\[|\]|{|}|"|<|>|&|\+|\*|\/|=|:/ /g;
2283 # ... and split in words
2284 foreach (split / /,$line) {
2285 next unless $_; # skip empty values (multiple spaces)
2286 # if the entry is already here, improve weight
2287 # warn "managing $_";
2288 if ($result{$key}->{"$_"} =~ /$biblionumber,\Q$title\E\-(\d);/) {
2290 $result{$key}->{"$_"} =~ s/$biblionumber,\Q$title\E\-(\d);//;
2291 $result{$key}->{"$_"} .= "$biblionumber,$title-$weight;";
2293 # get the value if it exist in the nozebra table, otherwise, create it
2294 $sth2->execute($server,$key,$_);
2295 my $existing_biblionumbers = $sth2->fetchrow;
2297 if ($existing_biblionumbers) {
2298 $result{$key}->{"$_"} =$existing_biblionumbers;
2300 $result{$key}->{"$_"} =~ s/$biblionumber,\Q$title\E\-(\d);//;
2301 $result{$key}->{"$_"} .= "$biblionumber,$title-$weight;";
2302 # create a new ligne for this entry
2304 # warn "INSERT : $server / $key / $_";
2305 $dbh->do('INSERT INTO nozebra SET server='.$dbh->quote($server).', indexname='.$dbh->quote($key).',value='.$dbh->quote($_));
2306 $result{$key}->{"$_"}.="$biblionumber,$title-1;";
2312 # the subfield is not indexed, store it in __RAW__ index anyway
2314 my $line= lc $subfield->[1];
2315 $line =~ s/-|\.|\?|,|;|!|'|\(|\)|\[|\]|{|}|"|<|>|&|\+|\*|\/|=|:/ /g;
2316 # ... and split in words
2317 foreach (split / /,$line) {
2318 next unless $_; # skip empty values (multiple spaces)
2319 # if the entry is already here, improve weight
2320 if ($result{'__RAW__'}->{"$_"} =~ /$biblionumber,\Q$title\E\-(\d);/) {
2322 $result{'__RAW__'}->{"$_"} =~ s/$biblionumber,\Q$title\E\-(\d);//;
2323 $result{'__RAW__'}->{"$_"} .= "$biblionumber,$title-$weight;";
2325 # get the value if it exist in the nozebra table, otherwise, create it
2326 $sth2->execute($server,'__RAW__',$_);
2327 my $existing_biblionumbers = $sth2->fetchrow;
2329 if ($existing_biblionumbers) {
2330 $result{'__RAW__'}->{"$_"} =$existing_biblionumbers;
2332 $result{'__RAW__'}->{"$_"} =~ s/$biblionumber,\Q$title\E\-(\d);//;
2333 $result{'__RAW__'}->{"$_"} .= "$biblionumber,$title-$weight;";
2334 # create a new ligne for this entry
2336 $dbh->do('INSERT INTO nozebra SET server='.$dbh->quote($server).', indexname="__RAW__",value='.$dbh->quote($_));
2337 $result{'__RAW__'}->{"$_"}.="$biblionumber,$title-1;";
2352 ($indicators, $value) = _find_value($tag, $subfield, $record,$encoding);
2354 Find the given $subfield in the given $tag in the given
2355 MARC::Record $record. If the subfield is found, returns
2356 the (indicators, value) pair; otherwise, (undef, undef) is
2360 Such a function is used in addbiblio AND additem and serial-edit and maybe could be used in Authorities.
2361 I suggest we export it from this module.
2368 my ( $tagfield, $insubfield, $record, $encoding ) = @_;
2371 if ( $tagfield < 10 ) {
2372 if ( $record->field($tagfield) ) {
2373 push @result, $record->field($tagfield)->data();
2380 foreach my $field ( $record->field($tagfield) ) {
2381 my @subfields = $field->subfields();
2382 foreach my $subfield (@subfields) {
2383 if ( @$subfield[0] eq $insubfield ) {
2384 push @result, @$subfield[1];
2385 $indicator = $field->indicator(1) . $field->indicator(2);
2390 return ( $indicator, @result );
2393 =head2 _koha_marc_update_bib_ids
2397 _koha_marc_update_bib_ids($record, $frameworkcode, $biblionumber, $biblioitemnumber);
2399 Internal function to add or update biblionumber and biblioitemnumber to
2406 sub _koha_marc_update_bib_ids {
2407 my ($record, $frameworkcode, $biblionumber, $biblioitemnumber) = @_;
2409 # we must add bibnum and bibitemnum in MARC::Record...
2410 # we build the new field with biblionumber and biblioitemnumber
2411 # we drop the original field
2412 # we add the new builded field.
2413 my ($biblio_tag, $biblio_subfield ) = GetMarcFromKohaField("biblio.biblionumber",$frameworkcode);
2414 my ($biblioitem_tag, $biblioitem_subfield ) = GetMarcFromKohaField("biblioitems.biblioitemnumber",$frameworkcode);
2416 if ($biblio_tag != $biblioitem_tag) {
2417 # biblionumber & biblioitemnumber are in different fields
2419 # deal with biblionumber
2420 my ($new_field, $old_field);
2421 if ($biblio_tag < 10) {
2422 $new_field = MARC::Field->new( $biblio_tag, $biblionumber );
2425 MARC::Field->new( $biblio_tag, '', '',
2426 "$biblio_subfield" => $biblionumber );
2429 # drop old field and create new one...
2430 $old_field = $record->field($biblio_tag);
2431 $record->delete_field($old_field);
2432 $record->append_fields($new_field);
2434 # deal with biblioitemnumber
2435 if ($biblioitem_tag < 10) {
2436 $new_field = MARC::Field->new( $biblioitem_tag, $biblioitemnumber, );
2439 MARC::Field->new( $biblioitem_tag, '', '',
2440 "$biblioitem_subfield" => $biblioitemnumber, );
2442 # drop old field and create new one...
2443 $old_field = $record->field($biblioitem_tag);
2444 $record->delete_field($old_field);
2445 $record->insert_fields_ordered($new_field);
2448 # biblionumber & biblioitemnumber are in the same field (can't be <10 as fields <10 have only 1 value)
2449 my $new_field = MARC::Field->new(
2450 $biblio_tag, '', '',
2451 "$biblio_subfield" => $biblionumber,
2452 "$biblioitem_subfield" => $biblioitemnumber
2455 # drop old field and create new one...
2456 my $old_field = $record->field($biblio_tag);
2457 $record->delete_field($old_field);
2458 $record->insert_fields_ordered($new_field);
2462 =head2 _koha_marc_update_biblioitem_cn_sort
2466 _koha_marc_update_biblioitem_cn_sort($marc, $biblioitem, $frameworkcode);
2470 Given a MARC bib record and the biblioitem hash, update the
2471 subfield that contains a copy of the value of biblioitems.cn_sort.
2475 sub _koha_marc_update_biblioitem_cn_sort {
2477 my $biblioitem = shift;
2478 my $frameworkcode= shift;
2480 my ($biblioitem_tag, $biblioitem_subfield ) = GetMarcFromKohaField("biblioitems.cn_sort",$frameworkcode);
2481 next unless $biblioitem_tag;
2483 my ($cn_sort) = GetClassSort($biblioitem->{'biblioitems.cn_source'}, $biblioitem->{'cn_class'}, $biblioitem->{'cn_item'} );
2485 if (my $field = $marc->field($biblioitem_tag)) {
2486 $field->delete_subfield(code => $biblioitem_subfield);
2487 if ($cn_sort ne '') {
2488 $field->add_subfields($biblioitem_subfield => $cn_sort);
2491 # if we get here, no biblioitem tag is present in the MARC record, so
2492 # we'll create it if $cn_sort is not empty -- this would be
2493 # an odd combination of events, however
2495 $marc->insert_grouped_field(MARC::Field->new($biblioitem_tag, ' ', ' ', $biblioitem_subfield => $cn_sort));
2500 =head2 _koha_add_biblio
2504 my ($biblionumber,$error) = _koha_add_biblio($dbh,$biblioitem);
2506 Internal function to add a biblio ($biblio is a hash with the values)
2512 sub _koha_add_biblio {
2513 my ( $dbh, $biblio, $frameworkcode ) = @_;
2517 # set the series flag
2519 if ( $biblio->{'seriestitle'} ) { $serial = 1 };
2523 SET frameworkcode = ?,
2534 my $sth = $dbh->prepare($query);
2537 $biblio->{'author'},
2539 $biblio->{'unititle'},
2542 $biblio->{'seriestitle'},
2543 $biblio->{'copyrightdate'},
2544 $biblio->{'abstract'}
2547 my $biblionumber = $dbh->{'mysql_insertid'};
2548 if ( $dbh->errstr ) {
2549 $error.="ERROR in _koha_add_biblio $query".$dbh->errstr;
2554 #warn "LEAVING _koha_add_biblio: ".$biblionumber."\n";
2555 return ($biblionumber,$error);
2558 =head2 _koha_modify_biblio
2562 my ($biblionumber,$error) == _koha_modify_biblio($dbh,$biblio,$frameworkcode);
2564 Internal function for updating the biblio table
2570 sub _koha_modify_biblio {
2571 my ( $dbh, $biblio, $frameworkcode ) = @_;
2576 SET frameworkcode = ?,
2585 WHERE biblionumber = ?
2588 my $sth = $dbh->prepare($query);
2592 $biblio->{'author'},
2594 $biblio->{'unititle'},
2596 $biblio->{'serial'},
2597 $biblio->{'seriestitle'},
2598 $biblio->{'copyrightdate'},
2599 $biblio->{'abstract'},
2600 $biblio->{'biblionumber'}
2601 ) if $biblio->{'biblionumber'};
2603 if ( $dbh->errstr || !$biblio->{'biblionumber'} ) {
2604 $error.="ERROR in _koha_modify_biblio $query".$dbh->errstr;
2607 return ( $biblio->{'biblionumber'},$error );
2610 =head2 _koha_modify_biblioitem_nonmarc
2614 my ($biblioitemnumber,$error) = _koha_modify_biblioitem_nonmarc( $dbh, $biblioitem );
2616 Updates biblioitems row except for marc and marcxml, which should be changed
2623 sub _koha_modify_biblioitem_nonmarc {
2624 my ( $dbh, $biblioitem ) = @_;
2627 # re-calculate the cn_sort, it may have changed
2628 my ($cn_sort) = GetClassSort($biblioitem->{'biblioitems.cn_source'}, $biblioitem->{'cn_class'}, $biblioitem->{'cn_item'} );
2632 SET biblionumber = ?,
2638 publicationyear = ?,
2642 collectiontitle = ?,
2644 collectionvolume= ?,
2645 editionstatement= ?,
2646 editionresponsibility = ?,
2660 where biblioitemnumber = ?
2662 my $sth = $dbh->prepare($query);
2664 $biblioitem->{'biblionumber'},
2665 $biblioitem->{'volume'},
2666 $biblioitem->{'number'},
2667 $biblioitem->{'itemtype'},
2668 $biblioitem->{'isbn'},
2669 $biblioitem->{'issn'},
2670 $biblioitem->{'publicationyear'},
2671 $biblioitem->{'publishercode'},
2672 $biblioitem->{'volumedate'},
2673 $biblioitem->{'volumedesc'},
2674 $biblioitem->{'collectiontitle'},
2675 $biblioitem->{'collectionissn'},
2676 $biblioitem->{'collectionvolume'},
2677 $biblioitem->{'editionstatement'},
2678 $biblioitem->{'editionresponsibility'},
2679 $biblioitem->{'illus'},
2680 $biblioitem->{'pages'},
2681 $biblioitem->{'bnotes'},
2682 $biblioitem->{'size'},
2683 $biblioitem->{'place'},
2684 $biblioitem->{'lccn'},
2685 $biblioitem->{'url'},
2686 $biblioitem->{'biblioitems.cn_source'},
2687 $biblioitem->{'cn_class'},
2688 $biblioitem->{'cn_item'},
2689 $biblioitem->{'cn_suffix'},
2691 $biblioitem->{'totalissues'},
2692 $biblioitem->{'biblioitemnumber'}
2694 if ( $dbh->errstr ) {
2695 $error.="ERROR in _koha_modify_biblioitem_nonmarc $query".$dbh->errstr;
2698 return ($biblioitem->{'biblioitemnumber'},$error);
2701 =head2 _koha_add_biblioitem
2705 my ($biblioitemnumber,$error) = _koha_add_biblioitem( $dbh, $biblioitem );
2707 Internal function to add a biblioitem
2713 sub _koha_add_biblioitem {
2714 my ( $dbh, $biblioitem ) = @_;
2717 my ($cn_sort) = GetClassSort($biblioitem->{'biblioitems.cn_source'}, $biblioitem->{'cn_class'}, $biblioitem->{'cn_item'} );
2719 "INSERT INTO biblioitems SET
2726 publicationyear = ?,
2730 collectiontitle = ?,
2732 collectionvolume= ?,
2733 editionstatement= ?,
2734 editionresponsibility = ?,
2750 my $sth = $dbh->prepare($query);
2752 $biblioitem->{'biblionumber'},
2753 $biblioitem->{'volume'},
2754 $biblioitem->{'number'},
2755 $biblioitem->{'itemtype'},
2756 $biblioitem->{'isbn'},
2757 $biblioitem->{'issn'},
2758 $biblioitem->{'publicationyear'},
2759 $biblioitem->{'publishercode'},
2760 $biblioitem->{'volumedate'},
2761 $biblioitem->{'volumedesc'},
2762 $biblioitem->{'collectiontitle'},
2763 $biblioitem->{'collectionissn'},
2764 $biblioitem->{'collectionvolume'},
2765 $biblioitem->{'editionstatement'},
2766 $biblioitem->{'editionresponsibility'},
2767 $biblioitem->{'illus'},
2768 $biblioitem->{'pages'},
2769 $biblioitem->{'bnotes'},
2770 $biblioitem->{'size'},
2771 $biblioitem->{'place'},
2772 $biblioitem->{'lccn'},
2773 $biblioitem->{'marc'},
2774 $biblioitem->{'url'},
2775 $biblioitem->{'biblioitems.cn_source'},
2776 $biblioitem->{'cn_class'},
2777 $biblioitem->{'cn_item'},
2778 $biblioitem->{'cn_suffix'},
2780 $biblioitem->{'totalissues'}
2782 my $bibitemnum = $dbh->{'mysql_insertid'};
2783 if ( $dbh->errstr ) {
2784 $error.="ERROR in _koha_add_biblioitem $query".$dbh->errstr;
2788 return ($bibitemnum,$error);
2791 =head2 _koha_delete_biblio
2795 $error = _koha_delete_biblio($dbh,$biblionumber);
2797 Internal sub for deleting from biblio table -- also saves to deletedbiblio
2799 C<$dbh> - the database handle
2800 C<$biblionumber> - the biblionumber of the biblio to be deleted
2806 # FIXME: add error handling
2808 sub _koha_delete_biblio {
2809 my ( $dbh, $biblionumber ) = @_;
2811 # get all the data for this biblio
2812 my $sth = $dbh->prepare("SELECT * FROM biblio WHERE biblionumber=?");
2813 $sth->execute($biblionumber);
2815 if ( my $data = $sth->fetchrow_hashref ) {
2817 # save the record in deletedbiblio
2818 # find the fields to save
2819 my $query = "INSERT INTO deletedbiblio SET ";
2821 foreach my $temp ( keys %$data ) {
2822 $query .= "$temp = ?,";
2823 push( @bind, $data->{$temp} );
2826 # replace the last , by ",?)"
2828 my $bkup_sth = $dbh->prepare($query);
2829 $bkup_sth->execute(@bind);
2833 my $del_sth = $dbh->prepare("DELETE FROM biblio WHERE biblionumber=?");
2834 $del_sth->execute($biblionumber);
2841 =head2 _koha_delete_biblioitems
2845 $error = _koha_delete_biblioitems($dbh,$biblioitemnumber);
2847 Internal sub for deleting from biblioitems table -- also saves to deletedbiblioitems
2849 C<$dbh> - the database handle
2850 C<$biblionumber> - the biblioitemnumber of the biblioitem to be deleted
2856 # FIXME: add error handling
2858 sub _koha_delete_biblioitems {
2859 my ( $dbh, $biblioitemnumber ) = @_;
2861 # get all the data for this biblioitem
2863 $dbh->prepare("SELECT * FROM biblioitems WHERE biblioitemnumber=?");
2864 $sth->execute($biblioitemnumber);
2866 if ( my $data = $sth->fetchrow_hashref ) {
2868 # save the record in deletedbiblioitems
2869 # find the fields to save
2870 my $query = "INSERT INTO deletedbiblioitems SET ";
2872 foreach my $temp ( keys %$data ) {
2873 $query .= "$temp = ?,";
2874 push( @bind, $data->{$temp} );
2877 # replace the last , by ",?)"
2879 my $bkup_sth = $dbh->prepare($query);
2880 $bkup_sth->execute(@bind);
2883 # delete the biblioitem
2885 $dbh->prepare("DELETE FROM biblioitems WHERE biblioitemnumber=?");
2886 $del_sth->execute($biblioitemnumber);
2893 =head1 UNEXPORTED FUNCTIONS
2895 =head2 ModBiblioMarc
2897 &ModBiblioMarc($newrec,$biblionumber,$frameworkcode);
2899 Add MARC data for a biblio to koha
2901 Function exported, but should NOT be used, unless you really know what you're doing
2907 # pass the MARC::Record to this function, and it will create the records in the marc field
2908 my ( $record, $biblionumber, $frameworkcode ) = @_;
2909 my $dbh = C4::Context->dbh;
2910 my @fields = $record->fields();
2911 if ( !$frameworkcode ) {
2912 $frameworkcode = "";
2915 $dbh->prepare("UPDATE biblio SET frameworkcode=? WHERE biblionumber=?");
2916 $sth->execute( $frameworkcode, $biblionumber );
2918 my $encoding = C4::Context->preference("marcflavour");
2920 # deal with UNIMARC field 100 (encoding) : create it if needed & set encoding to unicode
2921 if ( $encoding eq "UNIMARC" ) {
2923 if ( length($record->subfield( 100, "a" )) == 35 ) {
2924 $string = $record->subfield( 100, "a" );
2925 my $f100 = $record->field(100);
2926 $record->delete_field($f100);
2929 $string = POSIX::strftime( "%Y%m%d", localtime );
2931 $string = sprintf( "%-*s", 35, $string );
2933 substr( $string, 22, 6, "frey50" );
2934 unless ( $record->subfield( 100, "a" ) ) {
2935 $record->insert_grouped_field(
2936 MARC::Field->new( 100, "", "", "a" => $string ) );
2939 ModZebra($biblionumber,"specialUpdate","biblioserver",$record);
2942 "UPDATE biblioitems SET marc=?,marcxml=? WHERE biblionumber=?");
2943 $sth->execute( $record->as_usmarc(), $record->as_xml_record($encoding),
2946 return $biblionumber;
2949 =head2 z3950_extended_services
2951 z3950_extended_services($serviceType,$serviceOptions,$record);
2953 z3950_extended_services is used to handle all interactions with Zebra's extended serices package, which is employed to perform all management of the MARC data stored in Zebra.
2955 C<$serviceType> one of: itemorder,create,drop,commit,update,xmlupdate
2957 C<$serviceOptions> a has of key/value pairs. For instance, if service_type is 'update', $service_options should contain:
2959 action => update action, one of specialUpdate, recordInsert, recordReplace, recordDelete, elementUpdate.
2963 recordidOpaque => Opaque Record ID (user supplied) or recordidNumber => Record ID number (system number).
2964 syntax => the record syntax (transfer syntax)
2965 databaseName = Database from connection object
2967 To set serviceOptions, call set_service_options($serviceType)
2969 C<$record> the record, if one is needed for the service type
2971 A record should be in XML. You can convert it to XML from MARC by running it through marc2xml().
2975 sub z3950_extended_services {
2976 my ( $server, $serviceType, $action, $serviceOptions ) = @_;
2978 # get our connection object
2979 my $Zconn = C4::Context->Zconn( $server, 0, 1 );
2981 # create a new package object
2982 my $Zpackage = $Zconn->package();
2985 $Zpackage->option( action => $action );
2987 if ( $serviceOptions->{'databaseName'} ) {
2988 $Zpackage->option( databaseName => $serviceOptions->{'databaseName'} );
2990 if ( $serviceOptions->{'recordIdNumber'} ) {
2992 recordIdNumber => $serviceOptions->{'recordIdNumber'} );
2994 if ( $serviceOptions->{'recordIdOpaque'} ) {
2996 recordIdOpaque => $serviceOptions->{'recordIdOpaque'} );
2999 # this is an ILL request (Zebra doesn't support it, but Koha could eventually)
3000 #if ($serviceType eq 'itemorder') {
3001 # $Zpackage->option('contact-name' => $serviceOptions->{'contact-name'});
3002 # $Zpackage->option('contact-phone' => $serviceOptions->{'contact-phone'});
3003 # $Zpackage->option('contact-email' => $serviceOptions->{'contact-email'});
3004 # $Zpackage->option('itemorder-item' => $serviceOptions->{'itemorder-item'});
3007 if ( $serviceOptions->{record} ) {
3008 $Zpackage->option( record => $serviceOptions->{record} );
3010 # can be xml or marc
3011 if ( $serviceOptions->{'syntax'} ) {
3012 $Zpackage->option( syntax => $serviceOptions->{'syntax'} );
3016 # send the request, handle any exception encountered
3017 eval { $Zpackage->send($serviceType) };
3018 if ( $@ && $@->isa("ZOOM::Exception") ) {
3019 return "error: " . $@->code() . " " . $@->message() . "\n";
3022 # free up package resources
3023 $Zpackage->destroy();
3026 =head2 set_service_options
3028 my $serviceOptions = set_service_options($serviceType);
3030 C<$serviceType> itemorder,create,drop,commit,update,xmlupdate
3032 Currently, we only support 'create', 'commit', and 'update'. 'drop' support will be added as soon as Zebra supports it.
3036 sub set_service_options {
3037 my ($serviceType) = @_;
3040 # FIXME: This needs to be an OID ... if we ever need 'syntax' this sub will need to change
3041 # $serviceOptions->{ 'syntax' } = ''; #zebra doesn't support syntaxes other than xml
3043 if ( $serviceType eq 'commit' ) {
3047 if ( $serviceType eq 'create' ) {
3051 if ( $serviceType eq 'drop' ) {
3052 die "ERROR: 'drop' not currently supported (by Zebra)";
3054 return $serviceOptions;
3063 Koha Developement team <info@koha.org>
3065 Paul POULAIN paul.poulain@free.fr
3067 Joshua Ferraro jmf@liblime.com