?  search:
summary | log | graphiclog1 | graphiclog2 | commit | commitdiff | tree | refs | edit | fork
blame | history | raw | HEAD
Bug 7284 follow-up, DBrev number
[koha.git] / C4 / Biblio.pm
blob81da91be74ed85b8f237860f14810526118c8c91
1 package C4::Biblio;
2
3 # Copyright 2000-2002 Katipo Communications
4 # Copyright 2010 BibLibre
5 # Copyright 2011 Equinox Software, Inc.
6 #
7 # This file is part of Koha.
8 #
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
12 # version.
13 #
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.
17 #
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.
21
22 use strict;
23 use warnings;
24 use Carp;
25
26 # use utf8;
27 use MARC::Record;
28 use MARC::File::USMARC;
29 use MARC::File::XML;
30 use POSIX qw(strftime);
31
32 use C4::Koha;
33 use C4::Dates qw/format_date/;
34 use C4::Log; # logaction
35 use C4::ClassSource;
36 use C4::Charset;
37 use C4::Linker;
38
39 use vars qw($VERSION @ISA @EXPORT);
40
41 BEGIN {
42 $VERSION = 1.00;
43
44 require Exporter;
45 @ISA = qw( Exporter );
46
47 # to add biblios
48 # EXPORTED FUNCTIONS.
49 push @EXPORT, qw(
50 &AddBiblio
51 );
52
53 # to get something
54 push @EXPORT, qw(
55 &Get
56 &GetBiblio
57 &GetBiblioData
58 &GetBiblioItemData
59 &GetBiblioItemInfosOf
60 &GetBiblioItemByBiblioNumber
61 &GetBiblioFromItemNumber
62 &GetBiblionumberFromItemnumber
63
64 &GetRecordValue
65 &GetFieldMapping
66 &SetFieldMapping
67 &DeleteFieldMapping
68
69 &GetISBDView
70
71 &GetMarcControlnumber
72 &GetMarcNotes
73 &GetMarcISBN
74 &GetMarcISSN
75 &GetMarcSubjects
76 &GetMarcBiblio
77 &GetMarcAuthors
78 &GetMarcSeries
79 &GetMarcHosts
80 GetMarcUrls
81 &GetUsedMarcStructure
82 &GetXmlBiblio
83 &GetCOinSBiblio
84 &GetMarcPrice
85 &GetMarcQuantity
86
87 &GetAuthorisedValueDesc
88 &GetMarcStructure
89 &GetMarcFromKohaField
90 &GetFrameworkCode
91 &TransformKohaToMarc
92 &PrepHostMarcField
93
94 &CountItemsIssued
95 &CountBiblioInOrders
96 &GetSubscriptionsId
97 &GetHolds
98 );
99
100 # To modify something
101 push @EXPORT, qw(
102 &ModBiblio
103 &ModBiblioframework
104 &ModZebra
105 );
106
107 # To delete something
108 push @EXPORT, qw(
109 &DelBiblio
110 );
111
112 # To link headings in a bib record
113 # to authority records.
114 push @EXPORT, qw(
115 &BiblioAutoLink
116 &LinkBibHeadingsToAuthorities
117 );
118
119 # Internal functions
120 # those functions are exported but should not be used
121 # they are usefull is few circumstances, so are exported.
122 # but don't use them unless you're a core developer ;-)
123 push @EXPORT, qw(
124 &ModBiblioMarc
125 );
126
127 # Others functions
128 push @EXPORT, qw(
129 &TransformMarcToKoha
130 &TransformHtmlToMarc2
131 &TransformHtmlToMarc
132 &TransformHtmlToXml
133 &GetNoZebraIndexes
134 );
135 }
136
137 eval {
138 if (C4::Context->ismemcached) {
139 require Memoize::Memcached;
140 import Memoize::Memcached qw(memoize_memcached);
141
142 memoize_memcached( 'GetMarcStructure',
143 memcached => C4::Context->memcached);
144 }
145 };
146
147 =head1 NAME
148
149 C4::Biblio - cataloging management functions
150
151 =head1 DESCRIPTION
152
153 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:
154
155 =over 4
156
157 =item 1. in the biblio,biblioitems,items, etc tables, which are limited to a one-to-one mapping to underlying MARC data
158
159 =item 2. as raw MARC in the Zebra index and storage engine
160
161 =item 3. as raw MARC the biblioitems.marc and biblioitems.marcxml
162
163 =back
164
165 In the 3.0 version of Koha, the authoritative record-level information is in biblioitems.marcxml
166
167 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.
168
169 =over 4
170
171 =item 1. Compared with MySQL, Zebra is slow to update an index for small data changes -- especially for proc-intensive operations like circulation
172
173 =item 2. Zebra's index has been known to crash and a backup of the data is necessary to rebuild it in such cases
174
175 =back
176
177 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:
178
179 =over 4
180
181 =item 1. Add*/Mod*/Del*/ - high-level external functions suitable for being called from external scripts to manage the collection
182
183 =item 2. _koha_* - low-level internal functions for managing the koha tables
184
185 =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.
186
187 =item 4. Zebra functions used to update the Zebra index
188
189 =item 5. internal helper functions such as char_decode, checkitems, etc. Some of these probably belong in Koha.pm
190
191 =back
192
193 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 :
194
195 =over 4
196
197 =item 1. save datas in biblio and biblioitems table, that gives us a biblionumber and a biblioitemnumber
198
199 =item 2. add the biblionumber and biblioitemnumber into the MARC records
200
201 =item 3. save the marc record
202
203 =back
204
205 When dealing with items, we must :
206
207 =over 4
208
209 =item 1. save the item in items table, that gives us an itemnumber
210
211 =item 2. add the itemnumber to the item MARC field
212
213 =item 3. overwrite the MARC record (with the added item) into biblioitems.marc(xml)
214
215 When modifying a biblio or an item, the behaviour is quite similar.
216
217 =back
218
219 =head1 EXPORTED FUNCTIONS
220
221 =head2 AddBiblio
222
223 ($biblionumber,$biblioitemnumber) = AddBiblio($record,$frameworkcode);
224
225 Exported function (core API) for adding a new biblio to koha.
226
227 The first argument is a C<MARC::Record> object containing the
228 bib to add, while the second argument is the desired MARC
229 framework code.
230
231 This function also accepts a third, optional argument: a hashref
232 to additional options. The only defined option is C<defer_marc_save>,
233 which if present and mapped to a true value, causes C<AddBiblio>
234 to omit the call to save the MARC in C<bibilioitems.marc>
235 and C<biblioitems.marcxml> This option is provided B<only>
236 for the use of scripts such as C<bulkmarcimport.pl> that may need
237 to do some manipulation of the MARC record for item parsing before
238 saving it and which cannot afford the performance hit of saving
239 the MARC record twice. Consequently, do not use that option
240 unless you can guarantee that C<ModBiblioMarc> will be called.
241
242 =cut
243
244 sub AddBiblio {
245 my $record = shift;
246 my $frameworkcode = shift;
247 my $options = @_ ? shift : undef;
248 my $defer_marc_save = 0;
249 if ( defined $options and exists $options->{'defer_marc_save'} and $options->{'defer_marc_save'} ) {
250 $defer_marc_save = 1;
251 }
252
253 my ( $biblionumber, $biblioitemnumber, $error );
254 my $dbh = C4::Context->dbh;
255
256 # transform the data into koha-table style data
257 SetUTF8Flag($record);
258 my $olddata = TransformMarcToKoha( $dbh, $record, $frameworkcode );
259 ( $biblionumber, $error ) = _koha_add_biblio( $dbh, $olddata, $frameworkcode );
260 $olddata->{'biblionumber'} = $biblionumber;
261 ( $biblioitemnumber, $error ) = _koha_add_biblioitem( $dbh, $olddata );
262
263 _koha_marc_update_bib_ids( $record, $frameworkcode, $biblionumber, $biblioitemnumber );
264
265 # update MARC subfield that stores biblioitems.cn_sort
266 _koha_marc_update_biblioitem_cn_sort( $record, $olddata, $frameworkcode );
267
268 # now add the record
269 ModBiblioMarc( $record, $biblionumber, $frameworkcode ) unless $defer_marc_save;
270
271 logaction( "CATALOGUING", "ADD", $biblionumber, "biblio" ) if C4::Context->preference("CataloguingLog");
272 return ( $biblionumber, $biblioitemnumber );
273 }
274
275 =head2 ModBiblio
276
277 ModBiblio( $record,$biblionumber,$frameworkcode);
278
279 Replace an existing bib record identified by C<$biblionumber>
280 with one supplied by the MARC::Record object C<$record>. The embedded
281 item, biblioitem, and biblionumber fields from the previous
282 version of the bib record replace any such fields of those tags that
283 are present in C<$record>. Consequently, ModBiblio() is not
284 to be used to try to modify item records.
285
286 C<$frameworkcode> specifies the MARC framework to use
287 when storing the modified bib record; among other things,
288 this controls how MARC fields get mapped to display columns
289 in the C<biblio> and C<biblioitems> tables, as well as
290 which fields are used to store embedded item, biblioitem,
291 and biblionumber data for indexing.
292
293 =cut
294
295 sub ModBiblio {
296 my ( $record, $biblionumber, $frameworkcode ) = @_;
297 croak "No record" unless $record;
298
299 if ( C4::Context->preference("CataloguingLog") ) {
300 my $newrecord = GetMarcBiblio($biblionumber);
301 logaction( "CATALOGUING", "MODIFY", $biblionumber, "BEFORE=>" . $newrecord->as_formatted );
302 }
303
304 # Cleaning up invalid fields must be done early or SetUTF8Flag is liable to
305 # throw an exception which probably won't be handled.
306 foreach my $field ($record->fields()) {
307 if (! $field->is_control_field()) {
308 if (scalar($field->subfields()) == 0 || (scalar($field->subfields()) == 1 && $field->subfield('9'))) {
309 $record->delete_field($field);
310 }
311 }
312 }
313
314 SetUTF8Flag($record);
315 my $dbh = C4::Context->dbh;
316
317 $frameworkcode = "" if !$frameworkcode || $frameworkcode eq "Default"; # XXX
318
319 _strip_item_fields($record, $frameworkcode);
320
321 # update biblionumber and biblioitemnumber in MARC
322 # FIXME - this is assuming a 1 to 1 relationship between
323 # biblios and biblioitems
324 my $sth = $dbh->prepare("select biblioitemnumber from biblioitems where biblionumber=?");
325 $sth->execute($biblionumber);
326 my ($biblioitemnumber) = $sth->fetchrow;
327 $sth->finish();
328 _koha_marc_update_bib_ids( $record, $frameworkcode, $biblionumber, $biblioitemnumber );
329
330 # load the koha-table data object
331 my $oldbiblio = TransformMarcToKoha( $dbh, $record, $frameworkcode );
332
333 # update MARC subfield that stores biblioitems.cn_sort
334 _koha_marc_update_biblioitem_cn_sort( $record, $oldbiblio, $frameworkcode );
335
336 # update the MARC record (that now contains biblio and items) with the new record data
337 &ModBiblioMarc( $record, $biblionumber, $frameworkcode );
338
339 # modify the other koha tables
340 _koha_modify_biblio( $dbh, $oldbiblio, $frameworkcode );
341 _koha_modify_biblioitem_nonmarc( $dbh, $oldbiblio );
342 return 1;
343 }
344
345 =head2 _strip_item_fields
346
347 _strip_item_fields($record, $frameworkcode)
348
349 Utility routine to remove item tags from a
350 MARC bib.
351
352 =cut
353
354 sub _strip_item_fields {
355 my $record = shift;
356 my $frameworkcode = shift;
357 # get the items before and append them to the biblio before updating the record, atm we just have the biblio
358 my ( $itemtag, $itemsubfield ) = GetMarcFromKohaField( "items.itemnumber", $frameworkcode );
359
360 # delete any item fields from incoming record to avoid
361 # duplication or incorrect data - use AddItem() or ModItem()
362 # to change items
363 foreach my $field ( $record->field($itemtag) ) {
364 $record->delete_field($field);
365 }
366 }
367
368 =head2 ModBiblioframework
369
370 ModBiblioframework($biblionumber,$frameworkcode);
371
372 Exported function to modify a biblio framework
373
374 =cut
375
376 sub ModBiblioframework {
377 my ( $biblionumber, $frameworkcode ) = @_;
378 my $dbh = C4::Context->dbh;
379 my $sth = $dbh->prepare( "UPDATE biblio SET frameworkcode=? WHERE biblionumber=?" );
380 $sth->execute( $frameworkcode, $biblionumber );
381 return 1;
382 }
383
384 =head2 DelBiblio
385
386 my $error = &DelBiblio($biblionumber);
387
388 Exported function (core API) for deleting a biblio in koha.
389 Deletes biblio record from Zebra and Koha tables (biblio,biblioitems,items)
390 Also backs it up to deleted* tables
391 Checks to make sure there are not issues on any of the items
392 return:
393 C<$error> : undef unless an error occurs
394
395 =cut
396
397 sub DelBiblio {
398 my ($biblionumber) = @_;
399 my $dbh = C4::Context->dbh;
400 my $error; # for error handling
401
402 # First make sure this biblio has no items attached
403 my $sth = $dbh->prepare("SELECT itemnumber FROM items WHERE biblionumber=?");
404 $sth->execute($biblionumber);
405 if ( my $itemnumber = $sth->fetchrow ) {
406
407 # Fix this to use a status the template can understand
408 $error .= "This Biblio has items attached, please delete them first before deleting this biblio ";
409 }
410
411 return $error if $error;
412
413 # We delete attached subscriptions
414 require C4::Serials;
415 my $subscriptions = C4::Serials::GetFullSubscriptionsFromBiblionumber($biblionumber);
416 foreach my $subscription (@$subscriptions) {
417 C4::Serials::DelSubscription( $subscription->{subscriptionid} );
418 }
419
420 # Delete in Zebra. Be careful NOT to move this line after _koha_delete_biblio
421 # for at least 2 reasons :
422 # - we need to read the biblio if NoZebra is set (to remove it from the indexes
423 # - if something goes wrong, the biblio may be deleted from Koha but not from zebra
424 # 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)
425 my $oldRecord;
426 if ( C4::Context->preference("NoZebra") ) {
427
428 # only NoZebra indexing needs to have
429 # the previous version of the record
430 $oldRecord = GetMarcBiblio($biblionumber);
431 }
432 ModZebra( $biblionumber, "recordDelete", "biblioserver", $oldRecord, undef );
433
434 # delete biblioitems and items from Koha tables and save in deletedbiblioitems,deleteditems
435 $sth = $dbh->prepare("SELECT biblioitemnumber FROM biblioitems WHERE biblionumber=?");
436 $sth->execute($biblionumber);
437 while ( my $biblioitemnumber = $sth->fetchrow ) {
438
439 # delete this biblioitem
440 $error = _koha_delete_biblioitems( $dbh, $biblioitemnumber );
441 return $error if $error;
442 }
443
444 # delete biblio from Koha tables and save in deletedbiblio
445 # must do this *after* _koha_delete_biblioitems, otherwise
446 # delete cascade will prevent deletedbiblioitems rows
447 # from being generated by _koha_delete_biblioitems
448 $error = _koha_delete_biblio( $dbh, $biblionumber );
449
450 logaction( "CATALOGUING", "DELETE", $biblionumber, "" ) if C4::Context->preference("CataloguingLog");
451
452 return;
453 }
454
455
456 =head2 BiblioAutoLink
457
458 my $headings_linked = BiblioAutoLink($record, $frameworkcode)
459
460 Automatically links headings in a bib record to authorities.
461
462 =cut
463
464 sub BiblioAutoLink {
465 my $record = shift;
466 my $frameworkcode = shift;
467 my ( $num_headings_changed, %results );
468
469 my $linker_module =
470 "C4::Linker::" . ( C4::Context->preference("LinkerModule") || 'Default' );
471 eval { eval "require $linker_module"; };
472 if ($@) {
473 $linker_module = 'C4::Linker::Default';
474 eval "require $linker_module";
475 }
476 if ($@) {
477 return 0, 0;
478 }
479
480 my $linker = $linker_module->new(
481 { 'options' => C4::Context->preference("LinkerOptions") } );
482 my ( $headings_changed, undef ) =
483 LinkBibHeadingsToAuthorities( $linker, $record, $frameworkcode, C4::Context->preference("CatalogModuleRelink") || '' );
484 # By default we probably don't want to relink things when cataloging
485 return $headings_changed;
486 }
487
488 =head2 LinkBibHeadingsToAuthorities
489
490 my $num_headings_changed, %results = LinkBibHeadingsToAuthorities($linker, $marc, $frameworkcode, [$allowrelink]);
491
492 Links bib headings to authority records by checking
493 each authority-controlled field in the C<MARC::Record>
494 object C<$marc>, looking for a matching authority record,
495 and setting the linking subfield $9 to the ID of that
496 authority record.
497
498 If $allowrelink is false, existing authids will never be
499 replaced, regardless of the values of LinkerKeepStale and
500 LinkerRelink.
501
502 Returns the number of heading links changed in the
503 MARC record.
504
505 =cut
506
507 sub LinkBibHeadingsToAuthorities {
508 my $linker = shift;
509 my $bib = shift;
510 my $frameworkcode = shift;
511 my $allowrelink = shift;
512 my %results;
513 require C4::Heading;
514 require C4::AuthoritiesMarc;
515
516 $allowrelink = 1 unless defined $allowrelink;
517 my $num_headings_changed = 0;
518 foreach my $field ( $bib->fields() ) {
519 my $heading = C4::Heading->new_from_bib_field( $field, $frameworkcode );
520 next unless defined $heading;
521
522 # check existing $9
523 my $current_link = $field->subfield('9');
524
525 if ( defined $current_link && (!$allowrelink || !C4::Context->preference('LinkerRelink')) )
526 {
527 $results{'linked'}->{ $heading->display_form() }++;
528 next;
529 }
530
531 my ( $authid, $fuzzy ) = $linker->get_link($heading);
532 if ($authid) {
533 $results{ $fuzzy ? 'fuzzy' : 'linked' }
534 ->{ $heading->display_form() }++;
535 next if defined $current_link and $current_link == $authid;
536
537 $field->delete_subfield( code => '9' ) if defined $current_link;
538 $field->add_subfields( '9', $authid );
539 $num_headings_changed++;
540 }
541 else {
542 if ( defined $current_link
543 && (!$allowrelink || C4::Context->preference('LinkerKeepStale')) )
544 {
545 $results{'fuzzy'}->{ $heading->display_form() }++;
546 }
547 elsif ( C4::Context->preference('AutoCreateAuthorities') ) {
548 my $authtypedata =
549 C4::AuthoritiesMarc::GetAuthType( $heading->auth_type() );
550 my $marcrecordauth = MARC::Record->new();
551 if ( C4::Context->preference('marcflavour') eq 'MARC21' ) {
552 $marcrecordauth->leader(' nz a22 o 4500');
553 SetMarcUnicodeFlag( $marcrecordauth, 'MARC21' );
554 }
555 my $authfield =
556 MARC::Field->new( $authtypedata->{auth_tag_to_report},
557 '', '', "a" => "" . $field->subfield('a') );
558 map {
559 $authfield->add_subfields( $_->[0] => $_->[1] )
560 if ( $_->[0] =~ /[A-z]/ && $_->[0] ne "a" )
561 } $field->subfields();
562 $marcrecordauth->insert_fields_ordered($authfield);
563
564 # bug 2317: ensure new authority knows it's using UTF-8; currently
565 # only need to do this for MARC21, as MARC::Record->as_xml_record() handles
566 # automatically for UNIMARC (by not transcoding)
567 # FIXME: AddAuthority() instead should simply explicitly require that the MARC::Record
568 # use UTF-8, but as of 2008-08-05, did not want to introduce that kind
569 # of change to a core API just before the 3.0 release.
570
571 if ( C4::Context->preference('marcflavour') eq 'MARC21' ) {
572 $marcrecordauth->insert_fields_ordered(
573 MARC::Field->new(
574 '667', '', '',
575 'a' => "Machine generated authority record."
576 )
577 );
578 my $cite =
579 $bib->author() . ", "
580 . $bib->title_proper() . ", "
581 . $bib->publication_date() . " ";
582 $cite =~ s/^[\s\,]*//;
583 $cite =~ s/[\s\,]*$//;
584 $cite =
585 "Work cat.: ("
586 . C4::Context->preference('MARCOrgCode') . ")"
587 . $bib->subfield( '999', 'c' ) . ": "
588 . $cite;
589 $marcrecordauth->insert_fields_ordered(
590 MARC::Field->new( '670', '', '', 'a' => $cite ) );
591 }
592
593 # warn "AUTH RECORD ADDED : ".$marcrecordauth->as_formatted;
594
595 $authid =
596 C4::AuthoritiesMarc::AddAuthority( $marcrecordauth, '',
597 $heading->auth_type() );
598 $field->add_subfields( '9', $authid );
599 $num_headings_changed++;
600 $results{'added'}->{ $heading->display_form() }++;
601 }
602 elsif ( defined $current_link ) {
603 $field->delete_subfield( code => '9' );
604 $num_headings_changed++;
605 $results{'unlinked'}->{ $heading->display_form() }++;
606 }
607 else {
608 $results{'unlinked'}->{ $heading->display_form() }++;
609 }
610 }
611
612 }
613 return $num_headings_changed, \%results;
614 }
615
616 =head2 GetRecordValue
617
618 my $values = GetRecordValue($field, $record, $frameworkcode);
619
620 Get MARC fields from a keyword defined in fieldmapping table.
621
622 =cut
623
624 sub GetRecordValue {
625 my ( $field, $record, $frameworkcode ) = @_;
626 my $dbh = C4::Context->dbh;
627
628 my $sth = $dbh->prepare('SELECT fieldcode, subfieldcode FROM fieldmapping WHERE frameworkcode = ? AND field = ?');
629 $sth->execute( $frameworkcode, $field );
630
631 my @result = ();
632
633 while ( my $row = $sth->fetchrow_hashref ) {
634 foreach my $field ( $record->field( $row->{fieldcode} ) ) {
635 if ( ( $row->{subfieldcode} ne "" && $field->subfield( $row->{subfieldcode} ) ) ) {
636 foreach my $subfield ( $field->subfield( $row->{subfieldcode} ) ) {
637 push @result, { 'subfield' => $subfield };
638 }
639
640 } elsif ( $row->{subfieldcode} eq "" ) {
641 push @result, { 'subfield' => $field->as_string() };
642 }
643 }
644 }
645
646 return \@result;
647 }
648
649 =head2 SetFieldMapping
650
651 SetFieldMapping($framework, $field, $fieldcode, $subfieldcode);
652
653 Set a Field to MARC mapping value, if it already exists we don't add a new one.
654
655 =cut
656
657 sub SetFieldMapping {
658 my ( $framework, $field, $fieldcode, $subfieldcode ) = @_;
659 my $dbh = C4::Context->dbh;
660
661 my $sth = $dbh->prepare('SELECT * FROM fieldmapping WHERE fieldcode = ? AND subfieldcode = ? AND frameworkcode = ? AND field = ?');
662 $sth->execute( $fieldcode, $subfieldcode, $framework, $field );
663 if ( not $sth->fetchrow_hashref ) {
664 my @args;
665 $sth = $dbh->prepare('INSERT INTO fieldmapping (fieldcode, subfieldcode, frameworkcode, field) VALUES(?,?,?,?)');
666
667 $sth->execute( $fieldcode, $subfieldcode, $framework, $field );
668 }
669 }
670
671 =head2 DeleteFieldMapping
672
673 DeleteFieldMapping($id);
674
675 Delete a field mapping from an $id.
676
677 =cut
678
679 sub DeleteFieldMapping {
680 my ($id) = @_;
681 my $dbh = C4::Context->dbh;
682
683 my $sth = $dbh->prepare('DELETE FROM fieldmapping WHERE id = ?');
684 $sth->execute($id);
685 }
686
687 =head2 GetFieldMapping
688
689 GetFieldMapping($frameworkcode);
690
691 Get all field mappings for a specified frameworkcode
692
693 =cut
694
695 sub GetFieldMapping {
696 my ($framework) = @_;
697 my $dbh = C4::Context->dbh;
698
699 my $sth = $dbh->prepare('SELECT * FROM fieldmapping where frameworkcode = ?');
700 $sth->execute($framework);
701
702 my @return;
703 while ( my $row = $sth->fetchrow_hashref ) {
704 push @return, $row;
705 }
706 return \@return;
707 }
708
709 =head2 GetBiblioData
710
711 $data = &GetBiblioData($biblionumber);
712
713 Returns information about the book with the given biblionumber.
714 C<&GetBiblioData> returns a reference-to-hash. The keys are the fields in
715 the C<biblio> and C<biblioitems> tables in the
716 Koha database.
717
718 In addition, C<$data-E<gt>{subject}> is the list of the book's
719 subjects, separated by C<" , "> (space, comma, space).
720 If there are multiple biblioitems with the given biblionumber, only
721 the first one is considered.
722
723 =cut
724
725 sub GetBiblioData {
726 my ($bibnum) = @_;
727 my $dbh = C4::Context->dbh;
728
729 # my $query = C4::Context->preference('item-level_itypes') ?
730 # " SELECT * , biblioitems.notes AS bnotes, biblio.notes
731 # FROM biblio
732 # LEFT JOIN biblioitems ON biblio.biblionumber = biblioitems.biblionumber
733 # WHERE biblio.biblionumber = ?
734 # AND biblioitems.biblionumber = biblio.biblionumber
735 #";
736
737 my $query = " SELECT * , biblioitems.notes AS bnotes, itemtypes.notforloan as bi_notforloan, biblio.notes
738 FROM biblio
739 LEFT JOIN biblioitems ON biblio.biblionumber = biblioitems.biblionumber
740 LEFT JOIN itemtypes ON biblioitems.itemtype = itemtypes.itemtype
741 WHERE biblio.biblionumber = ?
742 AND biblioitems.biblionumber = biblio.biblionumber ";
743
744 my $sth = $dbh->prepare($query);
745 $sth->execute($bibnum);
746 my $data;
747 $data = $sth->fetchrow_hashref;
748 $sth->finish;
749
750 return ($data);
751 } # sub GetBiblioData
752
753 =head2 &GetBiblioItemData
754
755 $itemdata = &GetBiblioItemData($biblioitemnumber);
756
757 Looks up the biblioitem with the given biblioitemnumber. Returns a
758 reference-to-hash. The keys are the fields from the C<biblio>,
759 C<biblioitems>, and C<itemtypes> tables in the Koha database, except
760 that C<biblioitems.notes> is given as C<$itemdata-E<gt>{bnotes}>.
761
762 =cut
763
764 #'
765 sub GetBiblioItemData {
766 my ($biblioitemnumber) = @_;
767 my $dbh = C4::Context->dbh;
768 my $query = "SELECT *,biblioitems.notes AS bnotes
769 FROM biblio LEFT JOIN biblioitems on biblio.biblionumber=biblioitems.biblionumber ";
770 unless ( C4::Context->preference('item-level_itypes') ) {
771 $query .= "LEFT JOIN itemtypes on biblioitems.itemtype=itemtypes.itemtype ";
772 }
773 $query .= " WHERE biblioitemnumber = ? ";
774 my $sth = $dbh->prepare($query);
775 my $data;
776 $sth->execute($biblioitemnumber);
777 $data = $sth->fetchrow_hashref;
778 $sth->finish;
779 return ($data);
780 } # sub &GetBiblioItemData
781
782 =head2 GetBiblioItemByBiblioNumber
783
784 NOTE : This function has been copy/paste from C4/Biblio.pm from head before zebra integration.
785
786 =cut
787
788 sub GetBiblioItemByBiblioNumber {
789 my ($biblionumber) = @_;
790 my $dbh = C4::Context->dbh;
791 my $sth = $dbh->prepare("Select * FROM biblioitems WHERE biblionumber = ?");
792 my $count = 0;
793 my @results;
794
795 $sth->execute($biblionumber);
796
797 while ( my $data = $sth->fetchrow_hashref ) {
798 push @results, $data;
799 }
800
801 $sth->finish;
802 return @results;
803 }
804
805 =head2 GetBiblionumberFromItemnumber
806
807
808 =cut
809
810 sub GetBiblionumberFromItemnumber {
811 my ($itemnumber) = @_;
812 my $dbh = C4::Context->dbh;
813 my $sth = $dbh->prepare("Select biblionumber FROM items WHERE itemnumber = ?");
814
815 $sth->execute($itemnumber);
816 my ($result) = $sth->fetchrow;
817 return ($result);
818 }
819
820 =head2 GetBiblioFromItemNumber
821
822 $item = &GetBiblioFromItemNumber($itemnumber,$barcode);
823
824 Looks up the item with the given itemnumber. if undef, try the barcode.
825
826 C<&itemnodata> returns a reference-to-hash whose keys are the fields
827 from the C<biblio>, C<biblioitems>, and C<items> tables in the Koha
828 database.
829
830 =cut
831
832 #'
833 sub GetBiblioFromItemNumber {
834 my ( $itemnumber, $barcode ) = @_;
835 my $dbh = C4::Context->dbh;
836 my $sth;
837 if ($itemnumber) {
838 $sth = $dbh->prepare(
839 "SELECT * FROM items
840 LEFT JOIN biblio ON biblio.biblionumber = items.biblionumber
841 LEFT JOIN biblioitems ON biblioitems.biblioitemnumber = items.biblioitemnumber
842 WHERE items.itemnumber = ?"
843 );
844 $sth->execute($itemnumber);
845 } else {
846 $sth = $dbh->prepare(
847 "SELECT * FROM items
848 LEFT JOIN biblio ON biblio.biblionumber = items.biblionumber
849 LEFT JOIN biblioitems ON biblioitems.biblioitemnumber = items.biblioitemnumber
850 WHERE items.barcode = ?"
851 );
852 $sth->execute($barcode);
853 }
854 my $data = $sth->fetchrow_hashref;
855 $sth->finish;
856 return ($data);
857 }
858
859 =head2 GetISBDView
860
861 $isbd = &GetISBDView($biblionumber);
862
863 Return the ISBD view which can be included in opac and intranet
864
865 =cut
866
867 sub GetISBDView {
868 my ( $biblionumber, $template ) = @_;
869 my $record = GetMarcBiblio($biblionumber, 1);
870 return undef unless defined $record;
871 my $itemtype = &GetFrameworkCode($biblionumber);
872 my ( $holdingbrtagf, $holdingbrtagsubf ) = &GetMarcFromKohaField( "items.holdingbranch", $itemtype );
873 my $tagslib = &GetMarcStructure( 1, $itemtype );
874
875 my $ISBD = C4::Context->preference('isbd');
876 my $bloc = $ISBD;
877 my $res;
878 my $blocres;
879
880 foreach my $isbdfield ( split( /#/, $bloc ) ) {
881
882 # $isbdfield= /(.?.?.?)/;
883 $isbdfield =~ /(\d\d\d)([^\|])?\|(.*)\|(.*)\|(.*)/;
884 my $fieldvalue = $1 || 0;
885 my $subfvalue = $2 || "";
886 my $textbefore = $3;
887 my $analysestring = $4;
888 my $textafter = $5;
889
890 # warn "==> $1 / $2 / $3 / $4";
891 # my $fieldvalue=substr($isbdfield,0,3);
892 if ( $fieldvalue > 0 ) {
893 my $hasputtextbefore = 0;
894 my @fieldslist = $record->field($fieldvalue);
895 @fieldslist = sort { $a->subfield($holdingbrtagsubf) cmp $b->subfield($holdingbrtagsubf) } @fieldslist if ( $fieldvalue eq $holdingbrtagf );
896
897 # warn "ERROR IN ISBD DEFINITION at : $isbdfield" unless $fieldvalue;
898 # warn "FV : $fieldvalue";
899 if ( $subfvalue ne "" ) {
900 foreach my $field (@fieldslist) {
901 foreach my $subfield ( $field->subfield($subfvalue) ) {
902 my $calculated = $analysestring;
903 my $tag = $field->tag();
904 if ( $tag < 10 ) {
905 } else {
906 my $subfieldvalue = GetAuthorisedValueDesc( $tag, $subfvalue, $subfield, '', $tagslib );
907 my $tagsubf = $tag . $subfvalue;
908 $calculated =~ s/\{(.?.?.?.?)$tagsubf(.*?)\}/$1$subfieldvalue$2\{$1$tagsubf$2\}/g;
909 if ( $template eq "opac" ) { $calculated =~ s#/cgi-bin/koha/[^/]+/([^.]*.pl\?.*)$#opac-$1#g; }
910
911 # field builded, store the result
912 if ( $calculated && !$hasputtextbefore ) { # put textbefore if not done
913 $blocres .= $textbefore;
914 $hasputtextbefore = 1;
915 }
916
917 # remove punctuation at start
918 $calculated =~ s/^( |;|:|\.|-)*//g;
919 $blocres .= $calculated;
920
921 }
922 }
923 }
924 $blocres .= $textafter if $hasputtextbefore;
925 } else {
926 foreach my $field (@fieldslist) {
927 my $calculated = $analysestring;
928 my $tag = $field->tag();
929 if ( $tag < 10 ) {
930 } else {
931 my @subf = $field->subfields;
932 for my $i ( 0 .. $#subf ) {
933 my $valuecode = $subf[$i][1];
934 my $subfieldcode = $subf[$i][0];
935 my $subfieldvalue = GetAuthorisedValueDesc( $tag, $subf[$i][0], $subf[$i][1], '', $tagslib );
936 my $tagsubf = $tag . $subfieldcode;
937
938 $calculated =~ s/ # replace all {{}} codes by the value code.
939 \{\{$tagsubf\}\} # catch the {{actualcode}}
940 /
941 $valuecode # replace by the value code
942 /gx;
943
944 $calculated =~ s/\{(.?.?.?.?)$tagsubf(.*?)\}/$1$subfieldvalue$2\{$1$tagsubf$2\}/g;
945 if ( $template eq "opac" ) { $calculated =~ s#/cgi-bin/koha/[^/]+/([^.]*.pl\?.*)$#opac-$1#g; }
946 }
947
948 # field builded, store the result
949 if ( $calculated && !$hasputtextbefore ) { # put textbefore if not done
950 $blocres .= $textbefore;
951 $hasputtextbefore = 1;
952 }
953
954 # remove punctuation at start
955 $calculated =~ s/^( |;|:|\.|-)*//g;
956 $blocres .= $calculated;
957 }
958 }
959 $blocres .= $textafter if $hasputtextbefore;
960 }
961 } else {
962 $blocres .= $isbdfield;
963 }
964 }
965 $res .= $blocres;
966
967 $res =~ s/\{(.*?)\}//g;
968 $res =~ s/\\n/\n/g;
969 $res =~ s/\n/<br\/>/g;
970
971 # remove empty ()
972 $res =~ s/\(\)//g;
973
974 return $res;
975 }
976
977 =head2 GetBiblio
978
979 ( $count, @results ) = &GetBiblio($biblionumber);
980
981 =cut
982
983 sub GetBiblio {
984 my ($biblionumber) = @_;
985 my $dbh = C4::Context->dbh;
986 my $sth = $dbh->prepare("SELECT * FROM biblio WHERE biblionumber = ?");
987 my $count = 0;
988 my @results;
989 $sth->execute($biblionumber);
990 while ( my $data = $sth->fetchrow_hashref ) {
991 $results[$count] = $data;
992 $count++;
993 } # while
994 $sth->finish;
995 return ( $count, @results );
996 } # sub GetBiblio
997
998 =head2 GetBiblioItemInfosOf
999
1000 GetBiblioItemInfosOf(@biblioitemnumbers);
1001
1002 =cut
1003
1004 sub GetBiblioItemInfosOf {
1005 my @biblioitemnumbers = @_;
1006
1007 my $query = '
1008 SELECT biblioitemnumber,
1009 publicationyear,
1010 itemtype
1011 FROM biblioitems
1012 WHERE biblioitemnumber IN (' . join( ',', @biblioitemnumbers ) . ')
1013 ';
1014 return get_infos_of( $query, 'biblioitemnumber' );
1015 }
1016
1017 =head1 FUNCTIONS FOR HANDLING MARC MANAGEMENT
1018
1019 =head2 GetMarcStructure
1020
1021 $res = GetMarcStructure($forlibrarian,$frameworkcode);
1022
1023 Returns a reference to a big hash of hash, with the Marc structure for the given frameworkcode
1024 $forlibrarian :if set to 1, the MARC descriptions are the librarians ones, otherwise it's the public (OPAC) ones
1025 $frameworkcode : the framework code to read
1026
1027 =cut
1028
1029 # cache for results of GetMarcStructure -- needed
1030 # for batch jobs
1031 our $marc_structure_cache;
1032
1033 sub GetMarcStructure {
1034 my ( $forlibrarian, $frameworkcode ) = @_;
1035 my $dbh = C4::Context->dbh;
1036 $frameworkcode = "" unless $frameworkcode;
1037
1038 if ( defined $marc_structure_cache and exists $marc_structure_cache->{$forlibrarian}->{$frameworkcode} ) {
1039 return $marc_structure_cache->{$forlibrarian}->{$frameworkcode};
1040 }
1041
1042 # my $sth = $dbh->prepare(
1043 # "SELECT COUNT(*) FROM marc_tag_structure WHERE frameworkcode=?");
1044 # $sth->execute($frameworkcode);
1045 # my ($total) = $sth->fetchrow;
1046 # $frameworkcode = "" unless ( $total > 0 );
1047 my $sth = $dbh->prepare(
1048 "SELECT tagfield,liblibrarian,libopac,mandatory,repeatable
1049 FROM marc_tag_structure
1050 WHERE frameworkcode=?
1051 ORDER BY tagfield"
1052 );
1053 $sth->execute($frameworkcode);
1054 my ( $liblibrarian, $libopac, $tag, $res, $tab, $mandatory, $repeatable );
1055
1056 while ( ( $tag, $liblibrarian, $libopac, $mandatory, $repeatable ) = $sth->fetchrow ) {
1057 $res->{$tag}->{lib} = ( $forlibrarian or !$libopac ) ? $liblibrarian : $libopac;
1058 $res->{$tag}->{tab} = "";
1059 $res->{$tag}->{mandatory} = $mandatory;
1060 $res->{$tag}->{repeatable} = $repeatable;
1061 }
1062
1063 $sth = $dbh->prepare(
1064 "SELECT tagfield,tagsubfield,liblibrarian,libopac,tab,mandatory,repeatable,authorised_value,authtypecode,value_builder,kohafield,seealso,hidden,isurl,link,defaultvalue
1065 FROM marc_subfield_structure
1066 WHERE frameworkcode=?
1067 ORDER BY tagfield,tagsubfield
1068 "
1069 );
1070
1071 $sth->execute($frameworkcode);
1072
1073 my $subfield;
1074 my $authorised_value;
1075 my $authtypecode;
1076 my $value_builder;
1077 my $kohafield;
1078 my $seealso;
1079 my $hidden;
1080 my $isurl;
1081 my $link;
1082 my $defaultvalue;
1083
1084 while (
1085 ( $tag, $subfield, $liblibrarian, $libopac, $tab, $mandatory, $repeatable, $authorised_value,
1086 $authtypecode, $value_builder, $kohafield, $seealso, $hidden, $isurl, $link, $defaultvalue
1087 )
1088 = $sth->fetchrow
1089 ) {
1090 $res->{$tag}->{$subfield}->{lib} = ( $forlibrarian or !$libopac ) ? $liblibrarian : $libopac;
1091 $res->{$tag}->{$subfield}->{tab} = $tab;
1092 $res->{$tag}->{$subfield}->{mandatory} = $mandatory;
1093 $res->{$tag}->{$subfield}->{repeatable} = $repeatable;
1094 $res->{$tag}->{$subfield}->{authorised_value} = $authorised_value;
1095 $res->{$tag}->{$subfield}->{authtypecode} = $authtypecode;
1096 $res->{$tag}->{$subfield}->{value_builder} = $value_builder;
1097 $res->{$tag}->{$subfield}->{kohafield} = $kohafield;
1098 $res->{$tag}->{$subfield}->{seealso} = $seealso;
1099 $res->{$tag}->{$subfield}->{hidden} = $hidden;
1100 $res->{$tag}->{$subfield}->{isurl} = $isurl;
1101 $res->{$tag}->{$subfield}->{'link'} = $link;
1102 $res->{$tag}->{$subfield}->{defaultvalue} = $defaultvalue;
1103 }
1104
1105 $marc_structure_cache->{$forlibrarian}->{$frameworkcode} = $res;
1106
1107 return $res;
1108 }
1109
1110 =head2 GetUsedMarcStructure
1111
1112 The same function as GetMarcStructure except it just takes field
1113 in tab 0-9. (used field)
1114
1115 my $results = GetUsedMarcStructure($frameworkcode);
1116
1117 C<$results> is a ref to an array which each case containts a ref
1118 to a hash which each keys is the columns from marc_subfield_structure
1119
1120 C<$frameworkcode> is the framework code.
1121
1122 =cut
1123
1124 sub GetUsedMarcStructure($) {
1125 my $frameworkcode = shift || '';
1126 my $query = qq/
1127 SELECT *
1128 FROM marc_subfield_structure
1129 WHERE tab > -1
1130 AND frameworkcode = ?
1131 ORDER BY tagfield, tagsubfield
1132 /;
1133 my $sth = C4::Context->dbh->prepare($query);
1134 $sth->execute($frameworkcode);
1135 return $sth->fetchall_arrayref( {} );
1136 }
1137
1138 =head2 GetMarcFromKohaField
1139
1140 ($MARCfield,$MARCsubfield)=GetMarcFromKohaField($kohafield,$frameworkcode);
1141
1142 Returns the MARC fields & subfields mapped to the koha field
1143 for the given frameworkcode
1144
1145 =cut
1146
1147 sub GetMarcFromKohaField {
1148 my ( $kohafield, $frameworkcode ) = @_;
1149 return (0, undef) unless $kohafield and defined $frameworkcode;
1150 my $relations = C4::Context->marcfromkohafield;
1151 if ( my $mf = $relations->{$frameworkcode}->{$kohafield} ) {
1152 return @$mf;
1153 }
1154 return (0, undef);
1155 }
1156
1157 =head2 GetMarcBiblio
1158
1159 my $record = GetMarcBiblio($biblionumber, [$embeditems]);
1160
1161 Returns MARC::Record representing bib identified by
1162 C<$biblionumber>. If no bib exists, returns undef.
1163 C<$embeditems>. If set to true, items data are included.
1164 The MARC record contains biblio data, and items data if $embeditems is set to true.
1165
1166 =cut
1167
1168 sub GetMarcBiblio {
1169 my $biblionumber = shift;
1170 my $embeditems = shift || 0;
1171 my $dbh = C4::Context->dbh;
1172 my $sth = $dbh->prepare("SELECT marcxml FROM biblioitems WHERE biblionumber=? ");
1173 $sth->execute($biblionumber);
1174 my $row = $sth->fetchrow_hashref;
1175 my $marcxml = StripNonXmlChars( $row->{'marcxml'} );
1176 MARC::File::XML->default_record_format( C4::Context->preference('marcflavour') );
1177 my $record = MARC::Record->new();
1178
1179 if ($marcxml) {
1180 $record = eval { MARC::Record::new_from_xml( $marcxml, "utf8", C4::Context->preference('marcflavour') ) };
1181 if ($@) { warn " problem with :$biblionumber : $@ \n$marcxml"; }
1182 return unless $record;
1183
1184 C4::Biblio::_koha_marc_update_bib_ids($record, '', $biblionumber, $biblionumber);
1185 C4::Biblio::EmbedItemsInMarcBiblio($record, $biblionumber) if ($embeditems);
1186
1187 return $record;
1188 } else {
1189 return undef;
1190 }
1191 }
1192
1193 =head2 GetXmlBiblio
1194
1195 my $marcxml = GetXmlBiblio($biblionumber);
1196
1197 Returns biblioitems.marcxml of the biblionumber passed in parameter.
1198 The XML contains both biblio & item datas
1199
1200 =cut
1201
1202 sub GetXmlBiblio {
1203 my ($biblionumber) = @_;
1204 my $dbh = C4::Context->dbh;
1205 my $sth = $dbh->prepare("SELECT marcxml FROM biblioitems WHERE biblionumber=? ");
1206 $sth->execute($biblionumber);
1207 my ($marcxml) = $sth->fetchrow;
1208 return $marcxml;
1209 }
1210
1211 =head2 GetCOinSBiblio
1212
1213 my $coins = GetCOinSBiblio($record);
1214
1215 Returns the COinS (a span) which can be included in a biblio record
1216
1217 =cut
1218
1219 sub GetCOinSBiblio {
1220 my $record = shift;
1221
1222 # get the coin format
1223 if ( ! $record ) {
1224 return;
1225 }
1226 my $pos7 = substr $record->leader(), 7, 1;
1227 my $pos6 = substr $record->leader(), 6, 1;
1228 my $mtx;
1229 my $genre;
1230 my ( $aulast, $aufirst ) = ( '', '' );
1231 my $oauthors = '';
1232 my $title = '';
1233 my $subtitle = '';
1234 my $pubyear = '';
1235 my $isbn = '';
1236 my $issn = '';
1237 my $publisher = '';
1238 my $pages = '';
1239 my $titletype = 'b';
1240
1241 # For the purposes of generating COinS metadata, LDR/06-07 can be
1242 # considered the same for UNIMARC and MARC21
1243 my $fmts6;
1244 my $fmts7;
1245 %$fmts6 = (
1246 'a' => 'book',
1247 'b' => 'manuscript',
1248 'c' => 'book',
1249 'd' => 'manuscript',
1250 'e' => 'map',
1251 'f' => 'map',
1252 'g' => 'film',
1253 'i' => 'audioRecording',
1254 'j' => 'audioRecording',
1255 'k' => 'artwork',
1256 'l' => 'document',
1257 'm' => 'computerProgram',
1258 'o' => 'document',
1259 'r' => 'document',
1260 );
1261 %$fmts7 = (
1262 'a' => 'journalArticle',
1263 's' => 'journal',
1264 );
1265
1266 $genre = $fmts6->{$pos6} ? $fmts6->{$pos6} : 'book';
1267
1268 if ( $genre eq 'book' ) {
1269 $genre = $fmts7->{$pos7} if $fmts7->{$pos7};
1270 }
1271
1272 ##### We must transform mtx to a valable mtx and document type ####
1273 if ( $genre eq 'book' ) {
1274 $mtx = 'book';
1275 } elsif ( $genre eq 'journal' ) {
1276 $mtx = 'journal';
1277 $titletype = 'j';
1278 } elsif ( $genre eq 'journalArticle' ) {
1279 $mtx = 'journal';
1280 $genre = 'article';
1281 $titletype = 'a';
1282 } else {
1283 $mtx = 'dc';
1284 }
1285
1286 $genre = ( $mtx eq 'dc' ) ? "&amp;rft.type=$genre" : "&amp;rft.genre=$genre";
1287
1288 if ( C4::Context->preference("marcflavour") eq "UNIMARC" ) {
1289
1290 # Setting datas
1291 $aulast = $record->subfield( '700', 'a' ) || '';
1292 $aufirst = $record->subfield( '700', 'b' ) || '';
1293 $oauthors = "&amp;rft.au=$aufirst $aulast";
1294
1295 # others authors
1296 if ( $record->field('200') ) {
1297 for my $au ( $record->field('200')->subfield('g') ) {
1298 $oauthors .= "&amp;rft.au=$au";
1299 }
1300 }
1301 $title =
1302 ( $mtx eq 'dc' )
1303 ? "&amp;rft.title=" . $record->subfield( '200', 'a' )
1304 : "&amp;rft.title=" . $record->subfield( '200', 'a' ) . "&amp;rft.btitle=" . $record->subfield( '200', 'a' );
1305 $pubyear = $record->subfield( '210', 'd' ) || '';
1306 $publisher = $record->subfield( '210', 'c' ) || '';
1307 $isbn = $record->subfield( '010', 'a' ) || '';
1308 $issn = $record->subfield( '011', 'a' ) || '';
1309 } else {
1310
1311 # MARC21 need some improve
1312
1313 # Setting datas
1314 if ( $record->field('100') ) {
1315 $oauthors .= "&amp;rft.au=" . $record->subfield( '100', 'a' );
1316 }
1317
1318 # others authors
1319 if ( $record->field('700') ) {
1320 for my $au ( $record->field('700')->subfield('a') ) {
1321 $oauthors .= "&amp;rft.au=$au";
1322 }
1323 }
1324 $title = "&amp;rft." . $titletype . "title=" . $record->subfield( '245', 'a' );
1325 $subtitle = $record->subfield( '245', 'b' ) || '';
1326 $title .= $subtitle;
1327 if ($titletype eq 'a') {
1328 $pubyear = $record->field('008') || '';
1329 $pubyear = substr($pubyear->data(), 7, 4) if $pubyear;
1330 $isbn = $record->subfield( '773', 'z' ) || '';
1331 $issn = $record->subfield( '773', 'x' ) || '';
1332 if ($mtx eq 'journal') {
1333 $title .= "&amp;rft.title=" . (($record->subfield( '773', 't' ) || $record->subfield( '773', 'a')));
1334 } else {
1335 $title .= "&amp;rft.btitle=" . (($record->subfield( '773', 't' ) || $record->subfield( '773', 'a')) || '');
1336 }
1337 foreach my $rel ($record->subfield( '773', 'g' )) {
1338 if ($pages) {
1339 $pages .= ', ';
1340 }
1341 $pages .= $rel;
1342 }
1343 } else {
1344 $pubyear = $record->subfield( '260', 'c' ) || '';
1345 $publisher = $record->subfield( '260', 'b' ) || '';
1346 $isbn = $record->subfield( '020', 'a' ) || '';
1347 $issn = $record->subfield( '022', 'a' ) || '';
1348 }
1349
1350 }
1351 my $coins_value =
1352 "ctx_ver=Z39.88-2004&amp;rft_val_fmt=info%3Aofi%2Ffmt%3Akev%3Amtx%3A$mtx$genre$title&amp;rft.isbn=$isbn&amp;rft.issn=$issn&amp;rft.aulast=$aulast&amp;rft.aufirst=$aufirst$oauthors&amp;rft.pub=$publisher&amp;rft.date=$pubyear&amp;rft.pages=$pages";
1353 $coins_value =~ s/(\ |&[^a])/\+/g;
1354 $coins_value =~ s/\"/\&quot\;/g;
1355
1356 #<!-- TMPL_VAR NAME="ocoins_format" -->&amp;rft.au=<!-- TMPL_VAR NAME="author" -->&amp;rft.btitle=<!-- TMPL_VAR NAME="title" -->&amp;rft.date=<!-- TMPL_VAR NAME="publicationyear" -->&amp;rft.pages=<!-- TMPL_VAR NAME="pages" -->&amp;rft.isbn=<!-- TMPL_VAR NAME=amazonisbn -->&amp;rft.aucorp=&amp;rft.place=<!-- TMPL_VAR NAME="place" -->&amp;rft.pub=<!-- TMPL_VAR NAME="publishercode" -->&amp;rft.edition=<!-- TMPL_VAR NAME="edition" -->&amp;rft.series=<!-- TMPL_VAR NAME="series" -->&amp;rft.genre="
1357
1358 return $coins_value;
1359 }
1360
1361
1362 =head2 GetMarcPrice
1363
1364 return the prices in accordance with the Marc format.
1365 =cut
1366
1367 sub GetMarcPrice {
1368 my ( $record, $marcflavour ) = @_;
1369 my @listtags;
1370 my $subfield;
1371
1372 if ( $marcflavour eq "MARC21" ) {
1373 @listtags = ('345', '020');
1374 $subfield="c";
1375 } elsif ( $marcflavour eq "UNIMARC" ) {
1376 @listtags = ('345', '010');
1377 $subfield="d";
1378 } else {
1379 return;
1380 }
1381
1382 for my $field ( $record->field(@listtags) ) {
1383 for my $subfield_value ($field->subfield($subfield)){
1384 #check value
1385 return $subfield_value if ($subfield_value);
1386 }
1387 }
1388 return 0; # no price found
1389 }
1390
1391 =head2 GetMarcQuantity
1392
1393 return the quantity of a book. Used in acquisition only, when importing a file an iso2709 from a bookseller
1394 Warning : this is not really in the marc standard. In Unimarc, Electre (the most widely used bookseller) use the 969$a
1395
1396 =cut
1397
1398 sub GetMarcQuantity {
1399 my ( $record, $marcflavour ) = @_;
1400 my @listtags;
1401 my $subfield;
1402
1403 if ( $marcflavour eq "MARC21" ) {
1404 return 0
1405 } elsif ( $marcflavour eq "UNIMARC" ) {
1406 @listtags = ('969');
1407 $subfield="a";
1408 } else {
1409 return;
1410 }
1411
1412 for my $field ( $record->field(@listtags) ) {
1413 for my $subfield_value ($field->subfield($subfield)){
1414 #check value
1415 if ($subfield_value) {
1416 # in France, the cents separator is the , but sometimes, ppl use a .
1417 # in this case, the price will be x100 when unformatted ! Replace the . by a , to get a proper price calculation
1418 $subfield_value =~ s/\./,/ if C4::Context->preference("CurrencyFormat") eq "FR";
1419 return $subfield_value;
1420 }
1421 }
1422 }
1423 return 0; # no price found
1424 }
1425
1426
1427 =head2 GetAuthorisedValueDesc
1428
1429 my $subfieldvalue =get_authorised_value_desc(
1430 $tag, $subf[$i][0],$subf[$i][1], '', $taglib, $category, $opac);
1431
1432 Retrieve the complete description for a given authorised value.
1433
1434 Now takes $category and $value pair too.
1435
1436 my $auth_value_desc =GetAuthorisedValueDesc(
1437 '','', 'DVD' ,'','','CCODE');
1438
1439 If the optional $opac parameter is set to a true value, displays OPAC
1440 descriptions rather than normal ones when they exist.
1441
1442 =cut
1443
1444 sub GetAuthorisedValueDesc {
1445 my ( $tag, $subfield, $value, $framework, $tagslib, $category, $opac ) = @_;
1446 my $dbh = C4::Context->dbh;
1447
1448 if ( !$category ) {
1449
1450 return $value unless defined $tagslib->{$tag}->{$subfield}->{'authorised_value'};
1451
1452 #---- branch
1453 if ( $tagslib->{$tag}->{$subfield}->{'authorised_value'} eq "branches" ) {
1454 return C4::Branch::GetBranchName($value);
1455 }
1456
1457 #---- itemtypes
1458 if ( $tagslib->{$tag}->{$subfield}->{'authorised_value'} eq "itemtypes" ) {
1459 return getitemtypeinfo($value)->{description};
1460 }
1461
1462 #---- "true" authorized value
1463 $category = $tagslib->{$tag}->{$subfield}->{'authorised_value'};
1464 }
1465
1466 if ( $category ne "" ) {
1467 my $sth = $dbh->prepare( "SELECT lib, lib_opac FROM authorised_values WHERE category = ? AND authorised_value = ?" );
1468 $sth->execute( $category, $value );
1469 my $data = $sth->fetchrow_hashref;
1470 return ( $opac && $data->{'lib_opac'} ) ? $data->{'lib_opac'} : $data->{'lib'};
1471 } else {
1472 return $value; # if nothing is found return the original value
1473 }
1474 }
1475
1476 =head2 GetMarcControlnumber
1477
1478 $marccontrolnumber = GetMarcControlnumber($record,$marcflavour);
1479
1480 Get the control number / record Identifier from the MARC record and return it.
1481
1482 =cut
1483
1484 sub GetMarcControlnumber {
1485 my ( $record, $marcflavour ) = @_;
1486 my $controlnumber = "";
1487 # Control number or Record identifier are the same field in MARC21, UNIMARC and NORMARC
1488 # Keep $marcflavour for possible later use
1489 if ($marcflavour eq "MARC21" || $marcflavour eq "UNIMARC" || $marcflavour eq "NORMARC") {
1490 my $controlnumberField = $record->field('001');
1491 if ($controlnumberField) {
1492 $controlnumber = $controlnumberField->data();
1493 }
1494 }
1495 return $controlnumber;
1496 }
1497
1498 =head2 GetMarcISBN
1499
1500 $marcisbnsarray = GetMarcISBN( $record, $marcflavour );
1501
1502 Get all ISBNs from the MARC record and returns them in an array.
1503 ISBNs stored in different fields depending on MARC flavour
1504
1505 =cut
1506
1507 sub GetMarcISBN {
1508 my ( $record, $marcflavour ) = @_;
1509 my $scope;
1510 if ( $marcflavour eq "UNIMARC" ) {
1511 $scope = '010';
1512 } else { # assume marc21 if not unimarc
1513 $scope = '020';
1514 }
1515 my @marcisbns;
1516 my $isbn = "";
1517 my $tag = "";
1518 my $marcisbn;
1519 foreach my $field ( $record->field($scope) ) {
1520 my $value = $field->as_string();
1521 if ( $isbn ne "" ) {
1522 $marcisbn = { marcisbn => $isbn, };
1523 push @marcisbns, $marcisbn;
1524 $isbn = $value;
1525 }
1526 if ( $isbn ne $value ) {
1527 $isbn = $isbn . " " . $value;
1528 }
1529 }
1530
1531 if ($isbn) {
1532 $marcisbn = { marcisbn => $isbn };
1533 push @marcisbns, $marcisbn; #load last tag into array
1534 }
1535 return \@marcisbns;
1536 } # end GetMarcISBN
1537
1538
1539 =head2 GetMarcISSN
1540
1541 $marcissnsarray = GetMarcISSN( $record, $marcflavour );
1542
1543 Get all valid ISSNs from the MARC record and returns them in an array.
1544 ISSNs are stored in different fields depending on MARC flavour
1545
1546 =cut
1547
1548 sub GetMarcISSN {
1549 my ( $record, $marcflavour ) = @_;
1550 my $scope;
1551 if ( $marcflavour eq "UNIMARC" ) {
1552 $scope = '011';
1553 }
1554 else { # assume MARC21 or NORMARC
1555 $scope = '022';
1556 }
1557 my @marcissns;
1558 foreach my $field ( $record->field($scope) ) {
1559 push @marcissns, $field->subfield( 'a' );
1560 }
1561 return \@marcissns;
1562 } # end GetMarcISSN
1563
1564 =head2 GetMarcNotes
1565
1566 $marcnotesarray = GetMarcNotes( $record, $marcflavour );
1567
1568 Get all notes from the MARC record and returns them in an array.
1569 The note are stored in different fields depending on MARC flavour
1570
1571 =cut
1572
1573 sub GetMarcNotes {
1574 my ( $record, $marcflavour ) = @_;
1575 my $scope;
1576 if ( $marcflavour eq "UNIMARC" ) {
1577 $scope = '3..';
1578 } else { # assume marc21 if not unimarc
1579 $scope = '5..';
1580 }
1581 my @marcnotes;
1582 my $note = "";
1583 my $tag = "";
1584 my $marcnote;
1585 foreach my $field ( $record->field($scope) ) {
1586 my $value = $field->as_string();
1587 if ( $note ne "" ) {
1588 $marcnote = { marcnote => $note, };
1589 push @marcnotes, $marcnote;
1590 $note = $value;
1591 }
1592 if ( $note ne $value ) {
1593 $note = $note . " " . $value;
1594 }
1595 }
1596
1597 if ($note) {
1598 $marcnote = { marcnote => $note };
1599 push @marcnotes, $marcnote; #load last tag into array
1600 }
1601 return \@marcnotes;
1602 } # end GetMarcNotes
1603
1604 =head2 GetMarcSubjects
1605
1606 $marcsubjcts = GetMarcSubjects($record,$marcflavour);
1607
1608 Get all subjects from the MARC record and returns them in an array.
1609 The subjects are stored in different fields depending on MARC flavour
1610
1611 =cut
1612
1613 sub GetMarcSubjects {
1614 my ( $record, $marcflavour ) = @_;
1615 my ( $mintag, $maxtag );
1616 if ( $marcflavour eq "UNIMARC" ) {
1617 $mintag = "600";
1618 $maxtag = "611";
1619 } else { # assume marc21 if not unimarc
1620 $mintag = "600";
1621 $maxtag = "699";
1622 }
1623
1624 my @marcsubjects;
1625 my $subject = "";
1626 my $subfield = "";
1627 my $marcsubject;
1628
1629 my $subject_limit = C4::Context->preference("TraceCompleteSubfields") ? 'su,complete-subfield' : 'su';
1630
1631 foreach my $field ( $record->field('6..') ) {
1632 next unless $field->tag() >= $mintag && $field->tag() <= $maxtag;
1633 my @subfields_loop;
1634 my @subfields = $field->subfields();
1635 my $counter = 0;
1636 my @link_loop;
1637
1638 # if there is an authority link, build the link with an= subfield9
1639 my $found9 = 0;
1640 for my $subject_subfield (@subfields) {
1641
1642 # don't load unimarc subfields 3,4,5
1643 next if ( ( $marcflavour eq "UNIMARC" ) and ( $subject_subfield->[0] =~ /2|3|4|5/ ) );
1644
1645 # don't load MARC21 subfields 2 (FIXME: any more subfields??)
1646 next if ( ( $marcflavour eq "MARC21" ) and ( $subject_subfield->[0] =~ /2/ ) );
1647 my $code = $subject_subfield->[0];
1648 my $value = $subject_subfield->[1];
1649 my $linkvalue = $value;
1650 $linkvalue =~ s/(\(|\))//g;
1651 my $operator;
1652 if ( $counter != 0 ) {
1653 $operator = ' and ';
1654 }
1655 if ( $code eq 9 ) {
1656 $found9 = 1;
1657 @link_loop = ( { 'limit' => 'an', link => "$linkvalue" } );
1658 }
1659 if ( not $found9 ) {
1660 push @link_loop, { 'limit' => $subject_limit, link => $linkvalue, operator => $operator };
1661 }
1662 my $separator;
1663 if ( $counter != 0 ) {
1664 $separator = C4::Context->preference('authoritysep');
1665 }
1666
1667 # ignore $9
1668 my @this_link_loop = @link_loop;
1669 push @subfields_loop, { code => $code, value => $value, link_loop => \@this_link_loop, separator => $separator } unless ( $subject_subfield->[0] eq 9 );
1670 $counter++;
1671 }
1672
1673 push @marcsubjects, { MARCSUBJECT_SUBFIELDS_LOOP => \@subfields_loop };
1674
1675 }
1676 return \@marcsubjects;
1677 } #end getMARCsubjects
1678
1679 =head2 GetMarcAuthors
1680
1681 authors = GetMarcAuthors($record,$marcflavour);
1682
1683 Get all authors from the MARC record and returns them in an array.
1684 The authors are stored in different fields depending on MARC flavour
1685
1686 =cut
1687
1688 sub GetMarcAuthors {
1689 my ( $record, $marcflavour ) = @_;
1690 my ( $mintag, $maxtag );
1691
1692 # tagslib useful for UNIMARC author reponsabilities
1693 my $tagslib =
1694 &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.
1695 if ( $marcflavour eq "UNIMARC" ) {
1696 $mintag = "700";
1697 $maxtag = "712";
1698 } elsif ( $marcflavour eq "MARC21" || $marcflavour eq "NORMARC" ) { # assume marc21 or normarc if not unimarc
1699 $mintag = "700";
1700 $maxtag = "720";
1701 } else {
1702 return;
1703 }
1704 my @marcauthors;
1705
1706 foreach my $field ( $record->fields ) {
1707 next unless $field->tag() >= $mintag && $field->tag() <= $maxtag;
1708 my @subfields_loop;
1709 my @link_loop;
1710 my @subfields = $field->subfields();
1711 my $count_auth = 0;
1712
1713 # if there is an authority link, build the link with Koha-Auth-Number: subfield9
1714 my $subfield9 = $field->subfield('9');
1715 for my $authors_subfield (@subfields) {
1716
1717 # don't load unimarc subfields 3, 5
1718 next if ( $marcflavour eq 'UNIMARC' and ( $authors_subfield->[0] =~ /3|5/ ) );
1719 my $subfieldcode = $authors_subfield->[0];
1720 my $value = $authors_subfield->[1];
1721 my $linkvalue = $value;
1722 $linkvalue =~ s/(\(|\))//g;
1723 my $operator;
1724 if ( $count_auth != 0 ) {
1725 $operator = ' and ';
1726 }
1727
1728 # if we have an authority link, use that as the link, otherwise use standard searching
1729 if ($subfield9) {
1730 @link_loop = ( { 'limit' => 'an', link => "$subfield9" } );
1731 } else {
1732
1733 # reset $linkvalue if UNIMARC author responsibility
1734 if ( $marcflavour eq 'UNIMARC' and ( $authors_subfield->[0] eq "4" ) ) {
1735 $linkvalue = "(" . GetAuthorisedValueDesc( $field->tag(), $authors_subfield->[0], $authors_subfield->[1], '', $tagslib ) . ")";
1736 }
1737 push @link_loop, { 'limit' => 'au', link => $linkvalue, operator => $operator };
1738 }
1739 $value = GetAuthorisedValueDesc( $field->tag(), $authors_subfield->[0], $authors_subfield->[1], '', $tagslib )
1740 if ( $marcflavour eq 'UNIMARC' and ( $authors_subfield->[0] =~ /4/ ) );
1741 my @this_link_loop = @link_loop;
1742 my $separator;
1743 if ( $count_auth != 0 ) {
1744 $separator = C4::Context->preference('authoritysep');
1745 }
1746 push @subfields_loop,
1747 { tag => $field->tag(),
1748 code => $subfieldcode,
1749 value => $value,
1750 link_loop => \@this_link_loop,
1751 separator => $separator
1752 }
1753 unless ( $authors_subfield->[0] eq '9' );
1754 $count_auth++;
1755 }
1756 push @marcauthors, { MARCAUTHOR_SUBFIELDS_LOOP => \@subfields_loop };
1757 }
1758 return \@marcauthors;
1759 }
1760
1761 =head2 GetMarcUrls
1762
1763 $marcurls = GetMarcUrls($record,$marcflavour);
1764
1765 Returns arrayref of URLs from MARC data, suitable to pass to tmpl loop.
1766 Assumes web resources (not uncommon in MARC21 to omit resource type ind)
1767
1768 =cut
1769
1770 sub GetMarcUrls {
1771 my ( $record, $marcflavour ) = @_;
1772
1773 my @marcurls;
1774 for my $field ( $record->field('856') ) {
1775 my @notes;
1776 for my $note ( $field->subfield('z') ) {
1777 push @notes, { note => $note };
1778 }
1779 my @urls = $field->subfield('u');
1780 foreach my $url (@urls) {
1781 my $marcurl;
1782 if ( $marcflavour eq 'MARC21' ) {
1783 my $s3 = $field->subfield('3');
1784 my $link = $field->subfield('y');
1785 unless ( $url =~ /^\w+:/ ) {
1786 if ( $field->indicator(1) eq '7' ) {
1787 $url = $field->subfield('2') . "://" . $url;
1788 } elsif ( $field->indicator(1) eq '1' ) {
1789 $url = 'ftp://' . $url;
1790 } else {
1791
1792 # properly, this should be if ind1=4,
1793 # however we will assume http protocol since we're building a link.
1794 $url = 'http://' . $url;
1795 }
1796 }
1797
1798 # TODO handle ind 2 (relationship)
1799 $marcurl = {
1800 MARCURL => $url,
1801 notes => \@notes,
1802 };
1803 $marcurl->{'linktext'} = $link || $s3 || C4::Context->preference('URLLinkText') || $url;
1804 $marcurl->{'part'} = $s3 if ($link);
1805 $marcurl->{'toc'} = 1 if ( defined($s3) && $s3 =~ /^[Tt]able/ );
1806 } else {
1807 $marcurl->{'linktext'} = $field->subfield('2') || C4::Context->preference('URLLinkText') || $url;
1808 $marcurl->{'MARCURL'} = $url;
1809 }
1810 push @marcurls, $marcurl;
1811 }
1812 }
1813 return \@marcurls;
1814 }
1815
1816 =head2 GetMarcSeries
1817
1818 $marcseriesarray = GetMarcSeries($record,$marcflavour);
1819
1820 Get all series from the MARC record and returns them in an array.
1821 The series are stored in different fields depending on MARC flavour
1822
1823 =cut
1824
1825 sub GetMarcSeries {
1826 my ( $record, $marcflavour ) = @_;
1827 my ( $mintag, $maxtag );
1828 if ( $marcflavour eq "UNIMARC" ) {
1829 $mintag = "600";
1830 $maxtag = "619";
1831 } else { # assume marc21 if not unimarc
1832 $mintag = "440";
1833 $maxtag = "490";
1834 }
1835
1836 my @marcseries;
1837 my $subjct = "";
1838 my $subfield = "";
1839 my $marcsubjct;
1840
1841 foreach my $field ( $record->field('440'), $record->field('490') ) {
1842 my @subfields_loop;
1843
1844 #my $value = $field->subfield('a');
1845 #$marcsubjct = {MARCSUBJCT => $value,};
1846 my @subfields = $field->subfields();
1847
1848 #warn "subfields:".join " ", @$subfields;
1849 my $counter = 0;
1850 my @link_loop;
1851 for my $series_subfield (@subfields) {
1852 my $volume_number;
1853 undef $volume_number;
1854
1855 # see if this is an instance of a volume
1856 if ( $series_subfield->[0] eq 'v' ) {
1857 $volume_number = 1;
1858 }
1859
1860 my $code = $series_subfield->[0];
1861 my $value = $series_subfield->[1];
1862 my $linkvalue = $value;
1863 $linkvalue =~ s/(\(|\))//g;
1864 if ( $counter != 0 ) {
1865 push @link_loop, { link => $linkvalue, operator => ' and ', };
1866 } else {
1867 push @link_loop, { link => $linkvalue, operator => undef, };
1868 }
1869 my $separator;
1870 if ( $counter != 0 ) {
1871 $separator = C4::Context->preference('authoritysep');
1872 }
1873 if ($volume_number) {
1874 push @subfields_loop, { volumenum => $value };
1875 } else {
1876 if ( $series_subfield->[0] ne '9' ) {
1877 push @subfields_loop, {
1878 code => $code,
1879 value => $value,
1880 link_loop => \@link_loop,
1881 separator => $separator,
1882 volumenum => $volume_number,
1883 };
1884 }
1885 }
1886 $counter++;
1887 }
1888 push @marcseries, { MARCSERIES_SUBFIELDS_LOOP => \@subfields_loop };
1889
1890 #$marcsubjct = {MARCSUBJCT => $field->as_string(),};
1891 #push @marcsubjcts, $marcsubjct;
1892 #$subjct = $value;
1893
1894 }
1895 my $marcseriessarray = \@marcseries;
1896 return $marcseriessarray;
1897 } #end getMARCseriess
1898
1899 =head2 GetMarcHosts
1900
1901 $marchostsarray = GetMarcHosts($record,$marcflavour);
1902
1903 Get all host records (773s MARC21, 461 UNIMARC) from the MARC record and returns them in an array.
1904
1905 =cut
1906
1907 sub GetMarcHosts {
1908 my ( $record, $marcflavour ) = @_;
1909 my ( $tag,$title_subf,$bibnumber_subf,$itemnumber_subf);
1910 $marcflavour ||="MARC21";
1911 if ( $marcflavour eq "MARC21" || $marcflavour eq "NORMARC" ) {
1912 $tag = "773";
1913 $title_subf = "t";
1914 $bibnumber_subf ="0";
1915 $itemnumber_subf='9';
1916 }
1917 elsif ($marcflavour eq "UNIMARC") {
1918 $tag = "461";
1919 $title_subf = "t";
1920 $bibnumber_subf ="0";
1921 $itemnumber_subf='9';
1922 };
1923
1924 my @marchosts;
1925
1926 foreach my $field ( $record->field($tag)) {
1927
1928 my @fields_loop;
1929
1930 my $hostbiblionumber = $field->subfield("$bibnumber_subf");
1931 my $hosttitle = $field->subfield($title_subf);
1932 my $hostitemnumber=$field->subfield($itemnumber_subf);
1933 push @fields_loop, { hostbiblionumber => $hostbiblionumber, hosttitle => $hosttitle, hostitemnumber => $hostitemnumber};
1934 push @marchosts, { MARCHOSTS_FIELDS_LOOP => \@fields_loop };
1935
1936 }
1937 my $marchostsarray = \@marchosts;
1938 return $marchostsarray;
1939 }
1940
1941 =head2 GetFrameworkCode
1942
1943 $frameworkcode = GetFrameworkCode( $biblionumber )
1944
1945 =cut
1946
1947 sub GetFrameworkCode {
1948 my ($biblionumber) = @_;
1949 my $dbh = C4::Context->dbh;
1950 my $sth = $dbh->prepare("SELECT frameworkcode FROM biblio WHERE biblionumber=?");
1951 $sth->execute($biblionumber);
1952 my ($frameworkcode) = $sth->fetchrow;
1953 return $frameworkcode;
1954 }
1955
1956 =head2 TransformKohaToMarc
1957
1958 $record = TransformKohaToMarc( $hash )
1959
1960 This function builds partial MARC::Record from a hash
1961 Hash entries can be from biblio or biblioitems.
1962
1963 This function is called in acquisition module, to create a basic catalogue
1964 entry from user entry
1965
1966 =cut
1967
1968
1969 sub TransformKohaToMarc {
1970 my $hash = shift;
1971 my $record = MARC::Record->new();
1972 SetMarcUnicodeFlag( $record, C4::Context->preference("marcflavour") );
1973 my $db_to_marc = C4::Context->marcfromkohafield;
1974 while ( my ($name, $value) = each %$hash ) {
1975 next unless my $dtm = $db_to_marc->{''}->{$name};
1976 my ($tag, $letter) = @$dtm;
1977 foreach my $value ( split(/\s?\|\s?/, $value, -1) ) {
1978 if ( my $field = $record->field($tag) ) {
1979 $field->add_subfields( $letter => $value );
1980 }
1981 else {
1982 $record->insert_fields_ordered( MARC::Field->new(
1983 $tag, " ", " ", $letter => $value ) );
1984 }
1985 }
1986
1987 }
1988 return $record;
1989 }
1990
1991 =head2 PrepHostMarcField
1992
1993 $hostfield = PrepHostMarcField ( $hostbiblionumber,$hostitemnumber,$marcflavour )
1994
1995 This function returns a host field populated with data from the host record, the field can then be added to an analytical record
1996
1997 =cut
1998
1999 sub PrepHostMarcField {
2000 my ($hostbiblionumber,$hostitemnumber, $marcflavour) = @_;
2001 $marcflavour ||="MARC21";
2002
2003 require C4::Items;
2004 my $hostrecord = GetMarcBiblio($hostbiblionumber);
2005 my $item = C4::Items::GetItem($hostitemnumber);
2006
2007 my $hostmarcfield;
2008 if ( $marcflavour eq "MARC21" || $marcflavour eq "NORMARC" ) {
2009
2010 #main entry
2011 my $mainentry;
2012 if ($hostrecord->subfield('100','a')){
2013 $mainentry = $hostrecord->subfield('100','a');
2014 } elsif ($hostrecord->subfield('110','a')){
2015 $mainentry = $hostrecord->subfield('110','a');
2016 } else {
2017 $mainentry = $hostrecord->subfield('111','a');
2018 }
2019
2020 # qualification info
2021 my $qualinfo;
2022 if (my $field260 = $hostrecord->field('260')){
2023 $qualinfo = $field260->as_string( 'abc' );
2024 }
2025
2026
2027 #other fields
2028 my $ed = $hostrecord->subfield('250','a');
2029 my $barcode = $item->{'barcode'};
2030 my $title = $hostrecord->subfield('245','a');
2031
2032 # record control number, 001 with 003 and prefix
2033 my $recctrlno;
2034 if ($hostrecord->field('001')){
2035 $recctrlno = $hostrecord->field('001')->data();
2036 if ($hostrecord->field('003')){
2037 $recctrlno = '('.$hostrecord->field('003')->data().')'.$recctrlno;
2038 }
2039 }
2040
2041 # issn/isbn
2042 my $issn = $hostrecord->subfield('022','a');
2043 my $isbn = $hostrecord->subfield('020','a');
2044
2045
2046 $hostmarcfield = MARC::Field->new(
2047 773, '0', '',
2048 '0' => $hostbiblionumber,
2049 '9' => $hostitemnumber,
2050 'a' => $mainentry,
2051 'b' => $ed,
2052 'd' => $qualinfo,
2053 'o' => $barcode,
2054 't' => $title,
2055 'w' => $recctrlno,
2056 'x' => $issn,
2057 'z' => $isbn
2058 );
2059 } elsif ($marcflavour eq "UNIMARC") {
2060 $hostmarcfield = MARC::Field->new(
2061 461, '', '',
2062 '0' => $hostbiblionumber,
2063 't' => $hostrecord->subfield('200','a'),
2064 '9' => $hostitemnumber
2065 );
2066 };
2067
2068 return $hostmarcfield;
2069 }
2070
2071 =head2 TransformHtmlToXml
2072
2073 $xml = TransformHtmlToXml( $tags, $subfields, $values, $indicator,
2074 $ind_tag, $auth_type )
2075
2076 $auth_type contains :
2077
2078 =over
2079
2080 =item - nothing : rebuild a biblio. In UNIMARC the encoding is in 100$a pos 26/27
2081
2082 =item - UNIMARCAUTH : rebuild an authority. In UNIMARC, the encoding is in 100$a pos 13/14
2083
2084 =item - ITEM : rebuild an item : in UNIMARC, 100$a, it's in the biblio ! (otherwise, we would get 2 100 fields !)
2085
2086 =back
2087
2088 =cut
2089
2090 sub TransformHtmlToXml {
2091 my ( $tags, $subfields, $values, $indicator, $ind_tag, $auth_type ) = @_;
2092 my $xml = MARC::File::XML::header('UTF-8');
2093 $xml .= "<record>\n";
2094 $auth_type = C4::Context->preference('marcflavour') unless $auth_type;
2095 MARC::File::XML->default_record_format($auth_type);
2096
2097 # in UNIMARC, field 100 contains the encoding
2098 # check that there is one, otherwise the
2099 # MARC::Record->new_from_xml will fail (and Koha will die)
2100 my $unimarc_and_100_exist = 0;
2101 $unimarc_and_100_exist = 1 if $auth_type eq 'ITEM'; # if we rebuild an item, no need of a 100 field
2102 my $prevvalue;
2103 my $prevtag = -1;
2104 my $first = 1;
2105 my $j = -1;
2106 for ( my $i = 0 ; $i < @$tags ; $i++ ) {
2107
2108 if ( C4::Context->preference('marcflavour') eq 'UNIMARC' and @$tags[$i] eq "100" and @$subfields[$i] eq "a" ) {
2109
2110 # if we have a 100 field and it's values are not correct, skip them.
2111 # if we don't have any valid 100 field, we will create a default one at the end
2112 my $enc = substr( @$values[$i], 26, 2 );
2113 if ( $enc eq '01' or $enc eq '50' or $enc eq '03' ) {
2114 $unimarc_and_100_exist = 1;
2115 } else {
2116 next;
2117 }
2118 }
2119 @$values[$i] =~ s/&/&amp;/g;
2120 @$values[$i] =~ s/</&lt;/g;
2121 @$values[$i] =~ s/>/&gt;/g;
2122 @$values[$i] =~ s/"/&quot;/g;
2123 @$values[$i] =~ s/'/&apos;/g;
2124
2125 # if ( !utf8::is_utf8( @$values[$i] ) ) {
2126 # utf8::decode( @$values[$i] );
2127 # }
2128 if ( ( @$tags[$i] ne $prevtag ) ) {
2129 $j++ unless ( @$tags[$i] eq "" );
2130 my $indicator1 = eval { substr( @$indicator[$j], 0, 1 ) };
2131 my $indicator2 = eval { substr( @$indicator[$j], 1, 1 ) };
2132 my $ind1 = _default_ind_to_space($indicator1);
2133 my $ind2;
2134 if ( @$indicator[$j] ) {
2135 $ind2 = _default_ind_to_space($indicator2);
2136 } else {
2137 warn "Indicator in @$tags[$i] is empty";
2138 $ind2 = " ";
2139 }
2140 if ( !$first ) {
2141 $xml .= "</datafield>\n";
2142 if ( ( @$tags[$i] && @$tags[$i] > 10 )
2143 && ( @$values[$i] ne "" ) ) {
2144 $xml .= "<datafield tag=\"@$tags[$i]\" ind1=\"$ind1\" ind2=\"$ind2\">\n";
2145 $xml .= "<subfield code=\"@$subfields[$i]\">@$values[$i]</subfield>\n";
2146 $first = 0;
2147 } else {
2148 $first = 1;
2149 }
2150 } else {
2151 if ( @$values[$i] ne "" ) {
2152
2153 # leader
2154 if ( @$tags[$i] eq "000" ) {
2155 $xml .= "<leader>@$values[$i]</leader>\n";
2156 $first = 1;
2157
2158 # rest of the fixed fields
2159 } elsif ( @$tags[$i] < 10 ) {
2160 $xml .= "<controlfield tag=\"@$tags[$i]\">@$values[$i]</controlfield>\n";
2161 $first = 1;
2162 } else {
2163 $xml .= "<datafield tag=\"@$tags[$i]\" ind1=\"$ind1\" ind2=\"$ind2\">\n";
2164 $xml .= "<subfield code=\"@$subfields[$i]\">@$values[$i]</subfield>\n";
2165 $first = 0;
2166 }
2167 }
2168 }
2169 } else { # @$tags[$i] eq $prevtag
2170 my $indicator1 = eval { substr( @$indicator[$j], 0, 1 ) };
2171 my $indicator2 = eval { substr( @$indicator[$j], 1, 1 ) };
2172 my $ind1 = _default_ind_to_space($indicator1);
2173 my $ind2;
2174 if ( @$indicator[$j] ) {
2175 $ind2 = _default_ind_to_space($indicator2);
2176 } else {
2177 warn "Indicator in @$tags[$i] is empty";
2178 $ind2 = " ";
2179 }
2180 if ( @$values[$i] eq "" ) {
2181 } else {
2182 if ($first) {
2183 $xml .= "<datafield tag=\"@$tags[$i]\" ind1=\"$ind1\" ind2=\"$ind2\">\n";
2184 $first = 0;
2185 }
2186 $xml .= "<subfield code=\"@$subfields[$i]\">@$values[$i]</subfield>\n";
2187 }
2188 }
2189 $prevtag = @$tags[$i];
2190 }
2191 $xml .= "</datafield>\n" if $xml =~ m/<datafield/;
2192 if ( C4::Context->preference('marcflavour') eq 'UNIMARC' and !$unimarc_and_100_exist ) {
2193
2194 # warn "SETTING 100 for $auth_type";
2195 my $string = strftime( "%Y%m%d", localtime(time) );
2196
2197 # set 50 to position 26 is biblios, 13 if authorities
2198 my $pos = 26;
2199 $pos = 13 if $auth_type eq 'UNIMARCAUTH';
2200 $string = sprintf( "%-*s", 35, $string );
2201 substr( $string, $pos, 6, "50" );
2202 $xml .= "<datafield tag=\"100\" ind1=\"\" ind2=\"\">\n";
2203 $xml .= "<subfield code=\"a\">$string</subfield>\n";
2204 $xml .= "</datafield>\n";
2205 }
2206 $xml .= "</record>\n";
2207 $xml .= MARC::File::XML::footer();
2208 return $xml;
2209 }
2210
2211 =head2 _default_ind_to_space
2212
2213 Passed what should be an indicator returns a space
2214 if its undefined or zero length
2215
2216 =cut
2217
2218 sub _default_ind_to_space {
2219 my $s = shift;
2220 if ( !defined $s || $s eq q{} ) {
2221 return ' ';
2222 }
2223 return $s;
2224 }
2225
2226 =head2 TransformHtmlToMarc
2227
2228 L<$record> = TransformHtmlToMarc(L<$cgi>)
2229 L<$cgi> is the CGI object which containts the values for subfields
2230 {
2231 'tag_010_indicator1_531951' ,
2232 'tag_010_indicator2_531951' ,
2233 'tag_010_code_a_531951_145735' ,
2234 'tag_010_subfield_a_531951_145735' ,
2235 'tag_200_indicator1_873510' ,
2236 'tag_200_indicator2_873510' ,
2237 'tag_200_code_a_873510_673465' ,
2238 'tag_200_subfield_a_873510_673465' ,
2239 'tag_200_code_b_873510_704318' ,
2240 'tag_200_subfield_b_873510_704318' ,
2241 'tag_200_code_e_873510_280822' ,
2242 'tag_200_subfield_e_873510_280822' ,
2243 'tag_200_code_f_873510_110730' ,
2244 'tag_200_subfield_f_873510_110730' ,
2245 }
2246 L<$record> is the MARC::Record object.
2247
2248 =cut
2249
2250 sub TransformHtmlToMarc {
2251 my $cgi = shift;
2252
2253 my @params = $cgi->param();
2254
2255 # explicitly turn on the UTF-8 flag for all
2256 # 'tag_' parameters to avoid incorrect character
2257 # conversion later on
2258 my $cgi_params = $cgi->Vars;
2259 foreach my $param_name ( keys %$cgi_params ) {
2260 if ( $param_name =~ /^tag_/ ) {
2261 my $param_value = $cgi_params->{$param_name};
2262 if ( utf8::decode($param_value) ) {
2263 $cgi_params->{$param_name} = $param_value;
2264 }
2265
2266 # FIXME - need to do something if string is not valid UTF-8
2267 }
2268 }
2269
2270 # creating a new record
2271 my $record = MARC::Record->new();
2272 my $i = 0;
2273 my @fields;
2274 #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!
2275 while ( $params[$i] ) { # browse all CGI params
2276 my $param = $params[$i];
2277 my $newfield = 0;
2278
2279 # if we are on biblionumber, store it in the MARC::Record (it may not be in the edited fields)
2280 if ( $param eq 'biblionumber' ) {
2281 my ( $biblionumbertagfield, $biblionumbertagsubfield ) = &GetMarcFromKohaField( "biblio.biblionumber", '' );
2282 if ( $biblionumbertagfield < 10 ) {
2283 $newfield = MARC::Field->new( $biblionumbertagfield, $cgi->param($param), );
2284 } else {
2285 $newfield = MARC::Field->new( $biblionumbertagfield, '', '', "$biblionumbertagsubfield" => $cgi->param($param), );
2286 }
2287 push @fields, $newfield if ($newfield);
2288 } elsif ( $param =~ /^tag_(\d*)_indicator1_/ ) { # new field start when having 'input name="..._indicator1_..."
2289 my $tag = $1;
2290
2291 my $ind1 = _default_ind_to_space( substr( $cgi->param($param), 0, 1 ) );
2292 my $ind2 = _default_ind_to_space( substr( $cgi->param( $params[ $i + 1 ] ), 0, 1 ) );
2293 $newfield = 0;
2294 my $j = $i + 2;
2295
2296 if ( $tag < 10 ) { # no code for theses fields
2297 # in MARC editor, 000 contains the leader.
2298 if ( $tag eq '000' ) {
2299 # Force a fake leader even if not provided to avoid crashing
2300 # during decoding MARC record containing UTF-8 characters
2301 $record->leader(
2302 length( $cgi->param($params[$j+1]) ) == 24
2303 ? $cgi->param( $params[ $j + 1 ] )
2304 : ' nam a22 4500'
2305 )
2306 ;
2307 # between 001 and 009 (included)
2308 } elsif ( $cgi->param( $params[ $j + 1 ] ) ne '' ) {
2309 $newfield = MARC::Field->new( $tag, $cgi->param( $params[ $j + 1 ] ), );
2310 }
2311
2312 # > 009, deal with subfields
2313 } else {
2314 # browse subfields for this tag (reason for _code_ match)
2315 while(defined $params[$j] && $params[$j] =~ /_code_/) {
2316 last unless defined $params[$j+1];
2317 #if next param ne subfield, then it was probably empty
2318 #try next param by incrementing j
2319 if($params[$j+1]!~/_subfield_/) {$j++; next; }
2320 my $fval= $cgi->param($params[$j+1]);
2321 #check if subfield value not empty and field exists
2322 if($fval ne '' && $newfield) {
2323 $newfield->add_subfields( $cgi->param($params[$j]) => $fval);
2324 }
2325 elsif($fval ne '') {
2326 $newfield = MARC::Field->new( $tag, $ind1, $ind2, $cgi->param($params[$j]) => $fval );
2327 }
2328 $j += 2;
2329 } #end-of-while
2330 $i= $j-1; #update i for outer loop accordingly
2331 }
2332 push @fields, $newfield if ($newfield);
2333 }
2334 $i++;
2335 }
2336
2337 $record->append_fields(@fields);
2338 return $record;
2339 }
2340
2341 # cache inverted MARC field map
2342 our $inverted_field_map;
2343
2344 =head2 TransformMarcToKoha
2345
2346 $result = TransformMarcToKoha( $dbh, $record, $frameworkcode )
2347
2348 Extract data from a MARC bib record into a hashref representing
2349 Koha biblio, biblioitems, and items fields.
2350
2351 =cut
2352
2353 sub TransformMarcToKoha {
2354 my ( $dbh, $record, $frameworkcode, $limit_table ) = @_;
2355
2356 my $result;
2357 $limit_table = $limit_table || 0;
2358 $frameworkcode = '' unless defined $frameworkcode;
2359
2360 unless ( defined $inverted_field_map ) {
2361 $inverted_field_map = _get_inverted_marc_field_map();
2362 }
2363
2364 my %tables = ();
2365 if ( defined $limit_table && $limit_table eq 'items' ) {
2366 $tables{'items'} = 1;
2367 } else {
2368 $tables{'items'} = 1;
2369 $tables{'biblio'} = 1;
2370 $tables{'biblioitems'} = 1;
2371 }
2372
2373 # traverse through record
2374 MARCFIELD: foreach my $field ( $record->fields() ) {
2375 my $tag = $field->tag();
2376 next MARCFIELD unless exists $inverted_field_map->{$frameworkcode}->{$tag};
2377 if ( $field->is_control_field() ) {
2378 my $kohafields = $inverted_field_map->{$frameworkcode}->{$tag}->{list};
2379 ENTRY: foreach my $entry ( @{$kohafields} ) {
2380 my ( $subfield, $table, $column ) = @{$entry};
2381 next ENTRY unless exists $tables{$table};
2382 my $key = _disambiguate( $table, $column );
2383 if ( $result->{$key} ) {
2384 unless ( ( $key eq "biblionumber" or $key eq "biblioitemnumber" ) and ( $field->data() eq "" ) ) {
2385 $result->{$key} .= " | " . $field->data();
2386 }
2387 } else {
2388 $result->{$key} = $field->data();
2389 }
2390 }
2391 } else {
2392
2393 # deal with subfields
2394 MARCSUBFIELD: foreach my $sf ( $field->subfields() ) {
2395 my $code = $sf->[0];
2396 next MARCSUBFIELD unless exists $inverted_field_map->{$frameworkcode}->{$tag}->{sfs}->{$code};
2397 my $value = $sf->[1];
2398 SFENTRY: foreach my $entry ( @{ $inverted_field_map->{$frameworkcode}->{$tag}->{sfs}->{$code} } ) {
2399 my ( $table, $column ) = @{$entry};
2400 next SFENTRY unless exists $tables{$table};
2401 my $key = _disambiguate( $table, $column );
2402 if ( $result->{$key} ) {
2403 unless ( ( $key eq "biblionumber" or $key eq "biblioitemnumber" ) and ( $value eq "" ) ) {
2404 $result->{$key} .= " | " . $value;
2405 }
2406 } else {
2407 $result->{$key} = $value;
2408 }
2409 }
2410 }
2411 }
2412 }
2413
2414 # modify copyrightdate to keep only the 1st year found
2415 if ( exists $result->{'copyrightdate'} ) {
2416 my $temp = $result->{'copyrightdate'};
2417 $temp =~ m/c(\d\d\d\d)/;
2418 if ( $temp =~ m/c(\d\d\d\d)/ and $1 > 0 ) { # search cYYYY first
2419 $result->{'copyrightdate'} = $1;
2420 } else { # if no cYYYY, get the 1st date.
2421 $temp =~ m/(\d\d\d\d)/;
2422 $result->{'copyrightdate'} = $1;
2423 }
2424 }
2425
2426 # modify publicationyear to keep only the 1st year found
2427 if ( exists $result->{'publicationyear'} ) {
2428 my $temp = $result->{'publicationyear'};
2429 if ( $temp =~ m/c(\d\d\d\d)/ and $1 > 0 ) { # search cYYYY first
2430 $result->{'publicationyear'} = $1;
2431 } else { # if no cYYYY, get the 1st date.
2432 $temp =~ m/(\d\d\d\d)/;
2433 $result->{'publicationyear'} = $1;
2434 }
2435 }
2436
2437 return $result;
2438 }
2439
2440 sub _get_inverted_marc_field_map {
2441 my $field_map = {};
2442 my $relations = C4::Context->marcfromkohafield;
2443
2444 foreach my $frameworkcode ( keys %{$relations} ) {
2445 foreach my $kohafield ( keys %{ $relations->{$frameworkcode} } ) {
2446 next unless @{ $relations->{$frameworkcode}->{$kohafield} }; # not all columns are mapped to MARC tag & subfield
2447 my $tag = $relations->{$frameworkcode}->{$kohafield}->[0];
2448 my $subfield = $relations->{$frameworkcode}->{$kohafield}->[1];
2449 my ( $table, $column ) = split /[.]/, $kohafield, 2;
2450 push @{ $field_map->{$frameworkcode}->{$tag}->{list} }, [ $subfield, $table, $column ];
2451 push @{ $field_map->{$frameworkcode}->{$tag}->{sfs}->{$subfield} }, [ $table, $column ];
2452 }
2453 }
2454 return $field_map;
2455 }
2456
2457 =head2 _disambiguate
2458
2459 $newkey = _disambiguate($table, $field);
2460
2461 This is a temporary hack to distinguish between the
2462 following sets of columns when using TransformMarcToKoha.
2463
2464 items.cn_source & biblioitems.cn_source
2465 items.cn_sort & biblioitems.cn_sort
2466
2467 Columns that are currently NOT distinguished (FIXME
2468 due to lack of time to fully test) are:
2469
2470 biblio.notes and biblioitems.notes
2471 biblionumber
2472 timestamp
2473 biblioitemnumber
2474
2475 FIXME - this is necessary because prefixing each column
2476 name with the table name would require changing lots
2477 of code and templates, and exposing more of the DB
2478 structure than is good to the UI templates, particularly
2479 since biblio and bibloitems may well merge in a future
2480 version. In the future, it would also be good to
2481 separate DB access and UI presentation field names
2482 more.
2483
2484 =cut
2485
2486 sub CountItemsIssued {
2487 my ($biblionumber) = @_;
2488 my $dbh = C4::Context->dbh;
2489 my $sth = $dbh->prepare('SELECT COUNT(*) as issuedCount FROM items, issues WHERE items.itemnumber = issues.itemnumber AND items.biblionumber = ?');
2490 $sth->execute($biblionumber);
2491 my $row = $sth->fetchrow_hashref();
2492 return $row->{'issuedCount'};
2493 }
2494
2495 sub _disambiguate {
2496 my ( $table, $column ) = @_;
2497 if ( $column eq "cn_sort" or $column eq "cn_source" ) {
2498 return $table . '.' . $column;
2499 } else {
2500 return $column;
2501 }
2502
2503 }
2504
2505 =head2 get_koha_field_from_marc
2506
2507 $result->{_disambiguate($table, $field)} =
2508 get_koha_field_from_marc($table,$field,$record,$frameworkcode);
2509
2510 Internal function to map data from the MARC record to a specific non-MARC field.
2511 FIXME: this is meant to replace TransformMarcToKohaOneField after more testing.
2512
2513 =cut
2514
2515 sub get_koha_field_from_marc {
2516 my ( $koha_table, $koha_column, $record, $frameworkcode ) = @_;
2517 my ( $tagfield, $subfield ) = GetMarcFromKohaField( $koha_table . '.' . $koha_column, $frameworkcode );
2518 my $kohafield;
2519 foreach my $field ( $record->field($tagfield) ) {
2520 if ( $field->tag() < 10 ) {
2521 if ($kohafield) {
2522 $kohafield .= " | " . $field->data();
2523 } else {
2524 $kohafield = $field->data();
2525 }
2526 } else {
2527 if ( $field->subfields ) {
2528 my @subfields = $field->subfields();
2529 foreach my $subfieldcount ( 0 .. $#subfields ) {
2530 if ( $subfields[$subfieldcount][0] eq $subfield ) {
2531 if ($kohafield) {
2532 $kohafield .= " | " . $subfields[$subfieldcount][1];
2533 } else {
2534 $kohafield = $subfields[$subfieldcount][1];
2535 }
2536 }
2537 }
2538 }
2539 }
2540 }
2541 return $kohafield;
2542 }
2543
2544 =head2 TransformMarcToKohaOneField
2545
2546 $result = TransformMarcToKohaOneField( $kohatable, $kohafield, $record, $result, $frameworkcode )
2547
2548 =cut
2549
2550 sub TransformMarcToKohaOneField {
2551
2552 # FIXME ? if a field has a repeatable subfield that is used in old-db,
2553 # only the 1st will be retrieved...
2554 my ( $kohatable, $kohafield, $record, $result, $frameworkcode ) = @_;
2555 my $res = "";
2556 my ( $tagfield, $subfield ) = GetMarcFromKohaField( $kohatable . "." . $kohafield, $frameworkcode );
2557 foreach my $field ( $record->field($tagfield) ) {
2558 if ( $field->tag() < 10 ) {
2559 if ( $result->{$kohafield} ) {
2560 $result->{$kohafield} .= " | " . $field->data();
2561 } else {
2562 $result->{$kohafield} = $field->data();
2563 }
2564 } else {
2565 if ( $field->subfields ) {
2566 my @subfields = $field->subfields();
2567 foreach my $subfieldcount ( 0 .. $#subfields ) {
2568 if ( $subfields[$subfieldcount][0] eq $subfield ) {
2569 if ( $result->{$kohafield} ) {
2570 $result->{$kohafield} .= " | " . $subfields[$subfieldcount][1];
2571 } else {
2572 $result->{$kohafield} = $subfields[$subfieldcount][1];
2573 }
2574 }
2575 }
2576 }
2577 }
2578 }
2579 return $result;
2580 }
2581
2582
2583 #"
2584
2585 #
2586 # true ModZebra commented until indexdata fixes zebraDB crashes (it seems they occur on multiple updates
2587 # at the same time
2588 # replaced by a zebraqueue table, that is filled with ModZebra to run.
2589 # the table is emptied by misc/cronjobs/zebraqueue_start.pl script
2590 # =head2 ModZebrafiles
2591 #
2592 # &ModZebrafiles( $dbh, $biblionumber, $record, $folder, $server );
2593 #
2594 # =cut
2595 #
2596 # sub ModZebrafiles {
2597 #
2598 # my ( $dbh, $biblionumber, $record, $folder, $server ) = @_;
2599 #
2600 # my $op;
2601 # my $zebradir =
2602 # C4::Context->zebraconfig($server)->{directory} . "/" . $folder . "/";
2603 # unless ( opendir( DIR, "$zebradir" ) ) {
2604 # warn "$zebradir not found";
2605 # return;
2606 # }
2607 # closedir DIR;
2608 # my $filename = $zebradir . $biblionumber;
2609 #
2610 # if ($record) {
2611 # open( OUTPUT, ">", $filename . ".xml" );
2612 # print OUTPUT $record;
2613 # close OUTPUT;
2614 # }
2615 # }
2616
2617 =head2 ModZebra
2618
2619 ModZebra( $biblionumber, $op, $server, $oldRecord, $newRecord );
2620
2621 $biblionumber is the biblionumber we want to index
2622
2623 $op is specialUpdate or delete, and is used to know what we want to do
2624
2625 $server is the server that we want to update
2626
2627 $oldRecord is the MARC::Record containing the previous version of the record. This is used only when
2628 NoZebra=1, as NoZebra indexing needs to know the previous version of a record in order to
2629 do an update.
2630
2631 $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.
2632
2633 =cut
2634
2635 sub ModZebra {
2636 ###Accepts a $server variable thus we can use it for biblios authorities or other zebra dbs
2637 my ( $biblionumber, $op, $server, $oldRecord, $newRecord ) = @_;
2638 my $dbh = C4::Context->dbh;
2639
2640 # true ModZebra commented until indexdata fixes zebraDB crashes (it seems they occur on multiple updates
2641 # at the same time
2642 # replaced by a zebraqueue table, that is filled with ModZebra to run.
2643 # the table is emptied by misc/cronjobs/zebraqueue_start.pl script
2644
2645 if ( C4::Context->preference("NoZebra") ) {
2646
2647 # lock the nozebra table : we will read index lines, update them in Perl process
2648 # and write everything in 1 transaction.
2649 # lock the table to avoid someone else overwriting what we are doing
2650 $dbh->do('LOCK TABLES nozebra WRITE,biblio WRITE,biblioitems WRITE, systempreferences WRITE, auth_types WRITE, auth_header WRITE, auth_subfield_structure READ');
2651 my %result; # the result hash that will be built by deletion / add, and written on mySQL at the end, to improve speed
2652 if ( $op eq 'specialUpdate' ) {
2653
2654 # OK, we have to add or update the record
2655 # 1st delete (virtually, in indexes), if record actually exists
2656 if ($oldRecord) {
2657 %result = _DelBiblioNoZebra( $biblionumber, $oldRecord, $server );
2658 }
2659
2660 # ... add the record
2661 %result = _AddBiblioNoZebra( $biblionumber, $newRecord, $server, %result );
2662 } else {
2663
2664 # it's a deletion, delete the record...
2665 # warn "DELETE the record $biblionumber on $server".$record->as_formatted;
2666 %result = _DelBiblioNoZebra( $biblionumber, $oldRecord, $server );
2667 }
2668
2669 # ok, now update the database...
2670 my $sth = $dbh->prepare("UPDATE nozebra SET biblionumbers=? WHERE server=? AND indexname=? AND value=?");
2671 foreach my $key ( keys %result ) {
2672 foreach my $index ( keys %{ $result{$key} } ) {
2673 $sth->execute( $result{$key}->{$index}, $server, $key, $index );
2674 }
2675 }
2676 $dbh->do('UNLOCK TABLES');
2677 } else {
2678
2679 #
2680 # we use zebra, just fill zebraqueue table
2681 #
2682 my $check_sql = "SELECT COUNT(*) FROM zebraqueue
2683 WHERE server = ?
2684 AND biblio_auth_number = ?
2685 AND operation = ?
2686 AND done = 0";
2687 my $check_sth = $dbh->prepare_cached($check_sql);
2688 $check_sth->execute( $server, $biblionumber, $op );
2689 my ($count) = $check_sth->fetchrow_array;
2690 $check_sth->finish();
2691 if ( $count == 0 ) {
2692 my $sth = $dbh->prepare("INSERT INTO zebraqueue (biblio_auth_number,server,operation) VALUES(?,?,?)");
2693 $sth->execute( $biblionumber, $server, $op );
2694 $sth->finish;
2695 }
2696 }
2697 }
2698
2699 =head2 GetNoZebraIndexes
2700
2701 %indexes = GetNoZebraIndexes;
2702
2703 return the data from NoZebraIndexes syspref.
2704
2705 =cut
2706
2707 sub GetNoZebraIndexes {
2708 my $no_zebra_indexes = C4::Context->preference('NoZebraIndexes');
2709 my %indexes;
2710 INDEX: foreach my $line ( split /['"],[\n\r]*/, $no_zebra_indexes ) {
2711 $line =~ /(.*)=>(.*)/;
2712 my $index = $1; # initial ' or " is removed afterwards
2713 my $fields = $2;
2714 $index =~ s/'|"|\s//g;
2715 $fields =~ s/'|"|\s//g;
2716 $indexes{$index} = $fields;
2717 }
2718 return %indexes;
2719 }
2720
2721 =head2 EmbedItemsInMarcBiblio
2722
2723 EmbedItemsInMarcBiblio($marc, $biblionumber);
2724
2725 Given a MARC::Record object containing a bib record,
2726 modify it to include the items attached to it as 9XX
2727 per the bib's MARC framework.
2728
2729 =cut
2730
2731 sub EmbedItemsInMarcBiblio {
2732 my ($marc, $biblionumber) = @_;
2733 croak "No MARC record" unless $marc;
2734
2735 my $frameworkcode = GetFrameworkCode($biblionumber);
2736 _strip_item_fields($marc, $frameworkcode);
2737
2738 # ... and embed the current items
2739 my $dbh = C4::Context->dbh;
2740 my $sth = $dbh->prepare("SELECT itemnumber FROM items WHERE biblionumber = ?");
2741 $sth->execute($biblionumber);
2742 my @item_fields;
2743 my ( $itemtag, $itemsubfield ) = GetMarcFromKohaField( "items.itemnumber", $frameworkcode );
2744 while (my ($itemnumber) = $sth->fetchrow_array) {
2745 require C4::Items;
2746 my $item_marc = C4::Items::GetMarcItem($biblionumber, $itemnumber);
2747 push @item_fields, $item_marc->field($itemtag);
2748 }
2749 $marc->append_fields(@item_fields);
2750 }
2751
2752 =head1 INTERNAL FUNCTIONS
2753
2754 =head2 _DelBiblioNoZebra($biblionumber,$record,$server);
2755
2756 function to delete a biblio in NoZebra indexes
2757 This function does NOT delete anything in database : it reads all the indexes entries
2758 that have to be deleted & delete them in the hash
2759
2760 The SQL part is done either :
2761 - after the Add if we are modifying a biblio (delete + add again)
2762 - immediatly after this sub if we are doing a true deletion.
2763
2764 $server can be 'biblioserver' or 'authorityserver' : it indexes biblios or authorities (in the same table, $server being part of the table itself
2765
2766 =cut
2767
2768 sub _DelBiblioNoZebra {
2769 my ( $biblionumber, $record, $server ) = @_;
2770
2771 # Get the indexes
2772 my $dbh = C4::Context->dbh;
2773
2774 # Get the indexes
2775 my %index;
2776 my $title;
2777 if ( $server eq 'biblioserver' ) {
2778 %index = GetNoZebraIndexes;
2779
2780 # get title of the record (to store the 10 first letters with the index)
2781 my ( $titletag, $titlesubfield ) = GetMarcFromKohaField( 'biblio.title', '' ); # FIXME: should be GetFrameworkCode($biblionumber) ??
2782 $title = lc( $record->subfield( $titletag, $titlesubfield ) );
2783 } else {
2784
2785 # for authorities, the "title" is the $a mainentry
2786 my ( $auth_type_tag, $auth_type_sf ) = C4::AuthoritiesMarc::get_auth_type_location();
2787 my $authref = C4::AuthoritiesMarc::GetAuthType( $record->subfield( $auth_type_tag, $auth_type_sf ) );
2788 warn "ERROR : authtype undefined for " . $record->as_formatted unless $authref;
2789 $title = $record->subfield( $authref->{auth_tag_to_report}, 'a' );
2790 $index{'mainmainentry'} = $authref->{'auth_tag_to_report'} . 'a';
2791 $index{'mainentry'} = $authref->{'auth_tag_to_report'} . '*';
2792 $index{'auth_type'} = "${auth_type_tag}${auth_type_sf}";
2793 }
2794
2795 my %result;
2796
2797 # remove blancks comma (that could cause problem when decoding the string for CQL retrieval) and regexp specific values
2798 $title =~ s/ |,|;|\[|\]|\(|\)|\*|-|'|=//g;
2799
2800 # limit to 10 char, should be enough, and limit the DB size
2801 $title = substr( $title, 0, 10 );
2802
2803 #parse each field
2804 my $sth2 = $dbh->prepare('SELECT biblionumbers FROM nozebra WHERE server=? AND indexname=? AND value=?');
2805 foreach my $field ( $record->fields() ) {
2806
2807 #parse each subfield
2808 next if $field->tag < 10;
2809 foreach my $subfield ( $field->subfields() ) {
2810 my $tag = $field->tag();
2811 my $subfieldcode = $subfield->[0];
2812 my $indexed = 0;
2813
2814 # check each index to see if the subfield is stored somewhere
2815 # otherwise, store it in __RAW__ index
2816 foreach my $key ( keys %index ) {
2817
2818 # warn "examining $key index : ".$index{$key}." for $tag $subfieldcode";
2819 if ( $index{$key} =~ /$tag\*/ or $index{$key} =~ /$tag$subfieldcode/ ) {
2820 $indexed = 1;
2821 my $line = lc $subfield->[1];
2822
2823 # remove meaningless value in the field...
2824 $line =~ s/-|\.|\?|,|;|!|'|\(|\)|\[|\]|{|}|"|<|>|&|\+|\*|\/|=|:/ /g;
2825
2826 # ... and split in words
2827 foreach ( split / /, $line ) {
2828 next unless $_; # skip empty values (multiple spaces)
2829 # if the entry is already here, do nothing, the biblionumber has already be removed
2830 unless ( defined( $result{$key}->{$_} ) && ( $result{$key}->{$_} =~ /$biblionumber,$title\-(\d);/ ) ) {
2831
2832 # get the index value if it exist in the nozebra table and remove the entry, otherwise, do nothing
2833 $sth2->execute( $server, $key, $_ );
2834 my $existing_biblionumbers = $sth2->fetchrow;
2835
2836 # it exists
2837 if ($existing_biblionumbers) {
2838
2839 # warn " existing for $key $_: $existing_biblionumbers";
2840 $result{$key}->{$_} = $existing_biblionumbers;
2841 $result{$key}->{$_} =~ s/$biblionumber,$title\-(\d);//;
2842 }
2843 }
2844 }
2845 }
2846 }
2847
2848 # the subfield is not indexed, store it in __RAW__ index anyway
2849 unless ($indexed) {
2850 my $line = lc $subfield->[1];
2851 $line =~ s/-|\.|\?|,|;|!|'|\(|\)|\[|\]|{|}|"|<|>|&|\+|\*|\/|=|:/ /g;
2852
2853 # ... and split in words
2854 foreach ( split / /, $line ) {
2855 next unless $_; # skip empty values (multiple spaces)
2856 # if the entry is already here, do nothing, the biblionumber has already be removed
2857 unless ( $result{'__RAW__'}->{$_} =~ /$biblionumber,$title\-(\d);/ ) {
2858
2859 # get the index value if it exist in the nozebra table and remove the entry, otherwise, do nothing
2860 $sth2->execute( $server, '__RAW__', $_ );
2861 my $existing_biblionumbers = $sth2->fetchrow;
2862
2863 # it exists
2864 if ($existing_biblionumbers) {
2865 $result{'__RAW__'}->{$_} = $existing_biblionumbers;
2866 $result{'__RAW__'}->{$_} =~ s/$biblionumber,$title\-(\d);//;
2867 }
2868 }
2869 }
2870 }
2871 }
2872 }
2873 return %result;
2874 }
2875
2876 =head2 _AddBiblioNoZebra
2877
2878 _AddBiblioNoZebra($biblionumber, $record, $server, %result);
2879
2880 function to add a biblio in NoZebra indexes
2881
2882 =cut
2883
2884 sub _AddBiblioNoZebra {
2885 my ( $biblionumber, $record, $server, %result ) = @_;
2886 my $dbh = C4::Context->dbh;
2887
2888 # Get the indexes
2889 my %index;
2890 my $title;
2891 if ( $server eq 'biblioserver' ) {
2892 %index = GetNoZebraIndexes;
2893
2894 # get title of the record (to store the 10 first letters with the index)
2895 my ( $titletag, $titlesubfield ) = GetMarcFromKohaField( 'biblio.title', '' ); # FIXME: should be GetFrameworkCode($biblionumber) ??
2896 $title = lc( $record->subfield( $titletag, $titlesubfield ) );
2897 } else {
2898
2899 # warn "server : $server";
2900 # for authorities, the "title" is the $a mainentry
2901 my ( $auth_type_tag, $auth_type_sf ) = C4::AuthoritiesMarc::get_auth_type_location();
2902 my $authref = C4::AuthoritiesMarc::GetAuthType( $record->subfield( $auth_type_tag, $auth_type_sf ) );
2903 warn "ERROR : authtype undefined for " . $record->as_formatted unless $authref;
2904 $title = $record->subfield( $authref->{auth_tag_to_report}, 'a' );
2905 $index{'mainmainentry'} = $authref->{auth_tag_to_report} . 'a';
2906 $index{'mainentry'} = $authref->{auth_tag_to_report} . '*';
2907 $index{'auth_type'} = "${auth_type_tag}${auth_type_sf}";
2908 }
2909
2910 # remove blancks comma (that could cause problem when decoding the string for CQL retrieval) and regexp specific values
2911 $title =~ s/ |\.|,|;|\[|\]|\(|\)|\*|-|'|:|=|\r|\n//g;
2912
2913 # limit to 10 char, should be enough, and limit the DB size
2914 $title = substr( $title, 0, 10 );
2915
2916 #parse each field
2917 my $sth2 = $dbh->prepare('SELECT biblionumbers FROM nozebra WHERE server=? AND indexname=? AND value=?');
2918 foreach my $field ( $record->fields() ) {
2919
2920 #parse each subfield
2921 ###FIXME: impossible to index a 001-009 value with NoZebra
2922 next if $field->tag < 10;
2923 foreach my $subfield ( $field->subfields() ) {
2924 my $tag = $field->tag();
2925 my $subfieldcode = $subfield->[0];
2926 my $indexed = 0;
2927
2928 # warn "INDEXING :".$subfield->[1];
2929 # check each index to see if the subfield is stored somewhere
2930 # otherwise, store it in __RAW__ index
2931 foreach my $key ( keys %index ) {
2932
2933 # warn "examining $key index : ".$index{$key}." for $tag $subfieldcode";
2934 if ( $index{$key} =~ /$tag\*/ or $index{$key} =~ /$tag$subfieldcode/ ) {
2935 $indexed = 1;
2936 my $line = lc $subfield->[1];
2937
2938 # remove meaningless value in the field...
2939 $line =~ s/-|\.|\?|,|;|!|'|\(|\)|\[|\]|{|}|"|<|>|&|\+|\*|\/|=|:|\r|\n/ /g;
2940
2941 # ... and split in words
2942 foreach ( split / /, $line ) {
2943 next unless $_; # skip empty values (multiple spaces)
2944 # if the entry is already here, improve weight
2945
2946 # warn "managing $_";
2947 if ( exists $result{$key}->{$_} && $result{$key}->{"$_"} =~ /$biblionumber,\Q$title\E\-(\d+);/ ) {
2948 my $weight = $1 + 1;
2949 $result{$key}->{"$_"} =~ s/$biblionumber,\Q$title\E\-(\d+);//g;
2950 $result{$key}->{"$_"} .= "$biblionumber,$title-$weight;";
2951 } else {
2952
2953 # get the value if it exist in the nozebra table, otherwise, create it
2954 $sth2->execute( $server, $key, $_ );
2955 my $existing_biblionumbers = $sth2->fetchrow;
2956
2957 # it exists
2958 if ($existing_biblionumbers) {
2959 $result{$key}->{"$_"} = $existing_biblionumbers;
2960 my $weight = defined $1 ? $1 + 1 : 1;
2961 $result{$key}->{"$_"} =~ s/$biblionumber,\Q$title\E\-(\d+);//g;
2962 $result{$key}->{"$_"} .= "$biblionumber,$title-$weight;";
2963
2964 # create a new ligne for this entry
2965 } else {
2966
2967 # warn "INSERT : $server / $key / $_";
2968 $dbh->do( 'INSERT INTO nozebra SET server=' . $dbh->quote($server) . ', indexname=' . $dbh->quote($key) . ',value=' . $dbh->quote($_) );
2969 $result{$key}->{"$_"} .= "$biblionumber,$title-1;";
2970 }
2971 }
2972 }
2973 }
2974 }
2975
2976 # the subfield is not indexed, store it in __RAW__ index anyway
2977 unless ($indexed) {
2978 my $line = lc $subfield->[1];
2979 $line =~ s/-|\.|\?|,|;|!|'|\(|\)|\[|\]|{|}|"|<|>|&|\+|\*|\/|=|:|\r|\n/ /g;
2980
2981 # ... and split in words
2982 foreach ( split / /, $line ) {
2983 next unless $_; # skip empty values (multiple spaces)
2984 # if the entry is already here, improve weight
2985 my $tmpstr = $result{'__RAW__'}->{"$_"} || "";
2986 if ( $tmpstr =~ /$biblionumber,\Q$title\E\-(\d+);/ ) {
2987 my $weight = $1 + 1;
2988 $result{'__RAW__'}->{"$_"} =~ s/$biblionumber,\Q$title\E\-(\d+);//;
2989 $result{'__RAW__'}->{"$_"} .= "$biblionumber,$title-$weight;";
2990 } else {
2991
2992 # get the value if it exist in the nozebra table, otherwise, create it
2993 $sth2->execute( $server, '__RAW__', $_ );
2994 my $existing_biblionumbers = $sth2->fetchrow;
2995
2996 # it exists
2997 if ($existing_biblionumbers) {
2998 $result{'__RAW__'}->{"$_"} = $existing_biblionumbers;
2999 my $weight = ( $1 ? $1 : 0 ) + 1;
3000 $result{'__RAW__'}->{"$_"} =~ s/$biblionumber,\Q$title\E\-(\d+);//;
3001 $result{'__RAW__'}->{"$_"} .= "$biblionumber,$title-$weight;";
3002
3003 # create a new ligne for this entry
3004 } else {
3005 $dbh->do( 'INSERT INTO nozebra SET server=' . $dbh->quote($server) . ', indexname="__RAW__",value=' . $dbh->quote($_) );
3006 $result{'__RAW__'}->{"$_"} .= "$biblionumber,$title-1;";
3007 }
3008 }
3009 }
3010 }
3011 }
3012 }
3013 return %result;
3014 }
3015
3016 =head2 _koha_marc_update_bib_ids
3017
3018
3019 _koha_marc_update_bib_ids($record, $frameworkcode, $biblionumber, $biblioitemnumber);
3020
3021 Internal function to add or update biblionumber and biblioitemnumber to
3022 the MARC XML.
3023
3024 =cut
3025
3026 sub _koha_marc_update_bib_ids {
3027 my ( $record, $frameworkcode, $biblionumber, $biblioitemnumber ) = @_;
3028
3029 # we must add bibnum and bibitemnum in MARC::Record...
3030 # we build the new field with biblionumber and biblioitemnumber
3031 # we drop the original field
3032 # we add the new builded field.
3033 my ( $biblio_tag, $biblio_subfield ) = GetMarcFromKohaField( "biblio.biblionumber", $frameworkcode );
3034 die qq{No biblionumber tag for framework "$frameworkcode"} unless $biblio_tag;
3035 my ( $biblioitem_tag, $biblioitem_subfield ) = GetMarcFromKohaField( "biblioitems.biblioitemnumber", $frameworkcode );
3036 die qq{No biblioitemnumber tag for framework "$frameworkcode"} unless $biblio_tag;
3037
3038 if ( $biblio_tag == $biblioitem_tag ) {
3039
3040 # biblionumber & biblioitemnumber are in the same field (can't be <10 as fields <10 have only 1 value)
3041 my $new_field = MARC::Field->new(
3042 $biblio_tag, '', '',
3043 "$biblio_subfield" => $biblionumber,
3044 "$biblioitem_subfield" => $biblioitemnumber
3045 );
3046
3047 # drop old field and create new one...
3048 my $old_field = $record->field($biblio_tag);
3049 $record->delete_field($old_field) if $old_field;
3050 $record->insert_fields_ordered($new_field);
3051 } else {
3052
3053 # biblionumber & biblioitemnumber are in different fields
3054
3055 # deal with biblionumber
3056 my ( $new_field, $old_field );
3057 if ( $biblio_tag < 10 ) {
3058 $new_field = MARC::Field->new( $biblio_tag, $biblionumber );
3059 } else {
3060 $new_field = MARC::Field->new( $biblio_tag, '', '', "$biblio_subfield" => $biblionumber );
3061 }
3062
3063 # drop old field and create new one...
3064 $old_field = $record->field($biblio_tag);
3065 $record->delete_field($old_field) if $old_field;
3066 $record->insert_fields_ordered($new_field);
3067
3068 # deal with biblioitemnumber
3069 if ( $biblioitem_tag < 10 ) {
3070 $new_field = MARC::Field->new( $biblioitem_tag, $biblioitemnumber, );
3071 } else {
3072 $new_field = MARC::Field->new( $biblioitem_tag, '', '', "$biblioitem_subfield" => $biblioitemnumber, );
3073 }
3074
3075 # drop old field and create new one...
3076 $old_field = $record->field($biblioitem_tag);
3077 $record->delete_field($old_field) if $old_field;
3078 $record->insert_fields_ordered($new_field);
3079 }
3080 }
3081
3082 =head2 _koha_marc_update_biblioitem_cn_sort
3083
3084 _koha_marc_update_biblioitem_cn_sort($marc, $biblioitem, $frameworkcode);
3085
3086 Given a MARC bib record and the biblioitem hash, update the
3087 subfield that contains a copy of the value of biblioitems.cn_sort.
3088
3089 =cut
3090
3091 sub _koha_marc_update_biblioitem_cn_sort {
3092 my $marc = shift;
3093 my $biblioitem = shift;
3094 my $frameworkcode = shift;
3095
3096 my ( $biblioitem_tag, $biblioitem_subfield ) = GetMarcFromKohaField( "biblioitems.cn_sort", $frameworkcode );
3097 return unless $biblioitem_tag;
3098
3099 my ($cn_sort) = GetClassSort( $biblioitem->{'biblioitems.cn_source'}, $biblioitem->{'cn_class'}, $biblioitem->{'cn_item'} );
3100
3101 if ( my $field = $marc->field($biblioitem_tag) ) {
3102 $field->delete_subfield( code => $biblioitem_subfield );
3103 if ( $cn_sort ne '' ) {
3104 $field->add_subfields( $biblioitem_subfield => $cn_sort );
3105 }
3106 } else {
3107
3108 # if we get here, no biblioitem tag is present in the MARC record, so
3109 # we'll create it if $cn_sort is not empty -- this would be
3110 # an odd combination of events, however
3111 if ($cn_sort) {
3112 $marc->insert_grouped_field( MARC::Field->new( $biblioitem_tag, ' ', ' ', $biblioitem_subfield => $cn_sort ) );
3113 }
3114 }
3115 }
3116
3117 =head2 _koha_add_biblio
3118
3119 my ($biblionumber,$error) = _koha_add_biblio($dbh,$biblioitem);
3120
3121 Internal function to add a biblio ($biblio is a hash with the values)
3122
3123 =cut
3124
3125 sub _koha_add_biblio {
3126 my ( $dbh, $biblio, $frameworkcode ) = @_;
3127
3128 my $error;
3129
3130 # set the series flag
3131 unless (defined $biblio->{'serial'}){
3132 $biblio->{'serial'} = 0;
3133 if ( $biblio->{'seriestitle'} ) { $biblio->{'serial'} = 1 }
3134 }
3135
3136 my $query = "INSERT INTO biblio
3137 SET frameworkcode = ?,
3138 author = ?,
3139 title = ?,
3140 unititle =?,
3141 notes = ?,
3142 serial = ?,
3143 seriestitle = ?,
3144 copyrightdate = ?,
3145 datecreated=NOW(),
3146 abstract = ?
3147 ";
3148 my $sth = $dbh->prepare($query);
3149 $sth->execute(
3150 $frameworkcode, $biblio->{'author'}, $biblio->{'title'}, $biblio->{'unititle'}, $biblio->{'notes'},
3151 $biblio->{'serial'}, $biblio->{'seriestitle'}, $biblio->{'copyrightdate'}, $biblio->{'abstract'}
3152 );
3153
3154 my $biblionumber = $dbh->{'mysql_insertid'};
3155 if ( $dbh->errstr ) {
3156 $error .= "ERROR in _koha_add_biblio $query" . $dbh->errstr;
3157 warn $error;
3158 }
3159
3160 $sth->finish();
3161
3162 #warn "LEAVING _koha_add_biblio: ".$biblionumber."\n";
3163 return ( $biblionumber, $error );
3164 }
3165
3166 =head2 _koha_modify_biblio
3167
3168 my ($biblionumber,$error) == _koha_modify_biblio($dbh,$biblio,$frameworkcode);
3169
3170 Internal function for updating the biblio table
3171
3172 =cut
3173
3174 sub _koha_modify_biblio {
3175 my ( $dbh, $biblio, $frameworkcode ) = @_;
3176 my $error;
3177
3178 my $query = "
3179 UPDATE biblio
3180 SET frameworkcode = ?,
3181 author = ?,
3182 title = ?,
3183 unititle = ?,
3184 notes = ?,
3185 serial = ?,
3186 seriestitle = ?,
3187 copyrightdate = ?,
3188 abstract = ?
3189 WHERE biblionumber = ?
3190 "
3191 ;
3192 my $sth = $dbh->prepare($query);
3193
3194 $sth->execute(
3195 $frameworkcode, $biblio->{'author'}, $biblio->{'title'}, $biblio->{'unititle'}, $biblio->{'notes'},
3196 $biblio->{'serial'}, $biblio->{'seriestitle'}, $biblio->{'copyrightdate'}, $biblio->{'abstract'}, $biblio->{'biblionumber'}
3197 ) if $biblio->{'biblionumber'};
3198
3199 if ( $dbh->errstr || !$biblio->{'biblionumber'} ) {
3200 $error .= "ERROR in _koha_modify_biblio $query" . $dbh->errstr;
3201 warn $error;
3202 }
3203 return ( $biblio->{'biblionumber'}, $error );
3204 }
3205
3206 =head2 _koha_modify_biblioitem_nonmarc
3207
3208 my ($biblioitemnumber,$error) = _koha_modify_biblioitem_nonmarc( $dbh, $biblioitem );
3209
3210 Updates biblioitems row except for marc and marcxml, which should be changed
3211 via ModBiblioMarc
3212
3213 =cut
3214
3215 sub _koha_modify_biblioitem_nonmarc {
3216 my ( $dbh, $biblioitem ) = @_;
3217 my $error;
3218
3219 # re-calculate the cn_sort, it may have changed
3220 my ($cn_sort) = GetClassSort( $biblioitem->{'biblioitems.cn_source'}, $biblioitem->{'cn_class'}, $biblioitem->{'cn_item'} );
3221
3222 my $query = "UPDATE biblioitems
3223 SET biblionumber = ?,
3224 volume = ?,
3225 number = ?,
3226 itemtype = ?,
3227 isbn = ?,
3228 issn = ?,
3229 publicationyear = ?,
3230 publishercode = ?,
3231 volumedate = ?,
3232 volumedesc = ?,
3233 collectiontitle = ?,
3234 collectionissn = ?,
3235 collectionvolume= ?,
3236 editionstatement= ?,
3237 editionresponsibility = ?,
3238 illus = ?,
3239 pages = ?,
3240 notes = ?,
3241 size = ?,
3242 place = ?,
3243 lccn = ?,
3244 url = ?,
3245 cn_source = ?,
3246 cn_class = ?,
3247 cn_item = ?,
3248 cn_suffix = ?,
3249 cn_sort = ?,
3250 totalissues = ?
3251 where biblioitemnumber = ?
3252 ";
3253 my $sth = $dbh->prepare($query);
3254 $sth->execute(
3255 $biblioitem->{'biblionumber'}, $biblioitem->{'volume'}, $biblioitem->{'number'}, $biblioitem->{'itemtype'},
3256 $biblioitem->{'isbn'}, $biblioitem->{'issn'}, $biblioitem->{'publicationyear'}, $biblioitem->{'publishercode'},
3257 $biblioitem->{'volumedate'}, $biblioitem->{'volumedesc'}, $biblioitem->{'collectiontitle'}, $biblioitem->{'collectionissn'},
3258 $biblioitem->{'collectionvolume'}, $biblioitem->{'editionstatement'}, $biblioitem->{'editionresponsibility'}, $biblioitem->{'illus'},
3259 $biblioitem->{'pages'}, $biblioitem->{'bnotes'}, $biblioitem->{'size'}, $biblioitem->{'place'},
3260 $biblioitem->{'lccn'}, $biblioitem->{'url'}, $biblioitem->{'biblioitems.cn_source'}, $biblioitem->{'cn_class'},
3261 $biblioitem->{'cn_item'}, $biblioitem->{'cn_suffix'}, $cn_sort, $biblioitem->{'totalissues'},
3262 $biblioitem->{'biblioitemnumber'}
3263 );
3264 if ( $dbh->errstr ) {
3265 $error .= "ERROR in _koha_modify_biblioitem_nonmarc $query" . $dbh->errstr;
3266 warn $error;
3267 }
3268 return ( $biblioitem->{'biblioitemnumber'}, $error );
3269 }
3270
3271 =head2 _koha_add_biblioitem
3272
3273 my ($biblioitemnumber,$error) = _koha_add_biblioitem( $dbh, $biblioitem );
3274
3275 Internal function to add a biblioitem
3276
3277 =cut
3278
3279 sub _koha_add_biblioitem {
3280 my ( $dbh, $biblioitem ) = @_;
3281 my $error;
3282
3283 my ($cn_sort) = GetClassSort( $biblioitem->{'biblioitems.cn_source'}, $biblioitem->{'cn_class'}, $biblioitem->{'cn_item'} );
3284 my $query = "INSERT INTO biblioitems SET
3285 biblionumber = ?,
3286 volume = ?,
3287 number = ?,
3288 itemtype = ?,
3289 isbn = ?,
3290 issn = ?,
3291 publicationyear = ?,
3292 publishercode = ?,
3293 volumedate = ?,
3294 volumedesc = ?,
3295 collectiontitle = ?,
3296 collectionissn = ?,
3297 collectionvolume= ?,
3298 editionstatement= ?,
3299 editionresponsibility = ?,
3300 illus = ?,
3301 pages = ?,
3302 notes = ?,
3303 size = ?,
3304 place = ?,
3305 lccn = ?,
3306 marc = ?,
3307 url = ?,
3308 cn_source = ?,
3309 cn_class = ?,
3310 cn_item = ?,
3311 cn_suffix = ?,
3312 cn_sort = ?,
3313 totalissues = ?
3314 ";
3315 my $sth = $dbh->prepare($query);
3316 $sth->execute(
3317 $biblioitem->{'biblionumber'}, $biblioitem->{'volume'}, $biblioitem->{'number'}, $biblioitem->{'itemtype'},
3318 $biblioitem->{'isbn'}, $biblioitem->{'issn'}, $biblioitem->{'publicationyear'}, $biblioitem->{'publishercode'},
3319 $biblioitem->{'volumedate'}, $biblioitem->{'volumedesc'}, $biblioitem->{'collectiontitle'}, $biblioitem->{'collectionissn'},
3320 $biblioitem->{'collectionvolume'}, $biblioitem->{'editionstatement'}, $biblioitem->{'editionresponsibility'}, $biblioitem->{'illus'},
3321 $biblioitem->{'pages'}, $biblioitem->{'bnotes'}, $biblioitem->{'size'}, $biblioitem->{'place'},
3322 $biblioitem->{'lccn'}, $biblioitem->{'marc'}, $biblioitem->{'url'}, $biblioitem->{'biblioitems.cn_source'},
3323 $biblioitem->{'cn_class'}, $biblioitem->{'cn_item'}, $biblioitem->{'cn_suffix'}, $cn_sort,
3324 $biblioitem->{'totalissues'}
3325 );
3326 my $bibitemnum = $dbh->{'mysql_insertid'};
3327
3328 if ( $dbh->errstr ) {
3329 $error .= "ERROR in _koha_add_biblioitem $query" . $dbh->errstr;
3330 warn $error;
3331 }
3332 $sth->finish();
3333 return ( $bibitemnum, $error );
3334 }
3335
3336 =head2 _koha_delete_biblio
3337
3338 $error = _koha_delete_biblio($dbh,$biblionumber);
3339
3340 Internal sub for deleting from biblio table -- also saves to deletedbiblio
3341
3342 C<$dbh> - the database handle
3343
3344 C<$biblionumber> - the biblionumber of the biblio to be deleted
3345
3346 =cut
3347
3348 # FIXME: add error handling
3349
3350 sub _koha_delete_biblio {
3351 my ( $dbh, $biblionumber ) = @_;
3352
3353 # get all the data for this biblio
3354 my $sth = $dbh->prepare("SELECT * FROM biblio WHERE biblionumber=?");
3355 $sth->execute($biblionumber);
3356
3357 if ( my $data = $sth->fetchrow_hashref ) {
3358
3359 # save the record in deletedbiblio
3360 # find the fields to save
3361 my $query = "INSERT INTO deletedbiblio SET ";
3362 my @bind = ();
3363 foreach my $temp ( keys %$data ) {
3364 $query .= "$temp = ?,";
3365 push( @bind, $data->{$temp} );
3366 }
3367
3368 # replace the last , by ",?)"
3369 $query =~ s/\,$//;
3370 my $bkup_sth = $dbh->prepare($query);
3371 $bkup_sth->execute(@bind);
3372 $bkup_sth->finish;
3373
3374 # delete the biblio
3375 my $sth2 = $dbh->prepare("DELETE FROM biblio WHERE biblionumber=?");
3376 $sth2->execute($biblionumber);
3377 # update the timestamp (Bugzilla 7146)
3378 $sth2= $dbh->prepare("UPDATE deletedbiblio SET timestamp=NOW() WHERE biblionumber=?");
3379 $sth2->execute($biblionumber);
3380 $sth2->finish;
3381 }
3382 $sth->finish;
3383 return undef;
3384 }
3385
3386 =head2 _koha_delete_biblioitems
3387
3388 $error = _koha_delete_biblioitems($dbh,$biblioitemnumber);
3389
3390 Internal sub for deleting from biblioitems table -- also saves to deletedbiblioitems
3391
3392 C<$dbh> - the database handle
3393 C<$biblionumber> - the biblioitemnumber of the biblioitem to be deleted
3394
3395 =cut
3396
3397 # FIXME: add error handling
3398
3399 sub _koha_delete_biblioitems {
3400 my ( $dbh, $biblioitemnumber ) = @_;
3401
3402 # get all the data for this biblioitem
3403 my $sth = $dbh->prepare("SELECT * FROM biblioitems WHERE biblioitemnumber=?");
3404 $sth->execute($biblioitemnumber);
3405
3406 if ( my $data = $sth->fetchrow_hashref ) {
3407
3408 # save the record in deletedbiblioitems
3409 # find the fields to save
3410 my $query = "INSERT INTO deletedbiblioitems SET ";
3411 my @bind = ();
3412 foreach my $temp ( keys %$data ) {
3413 $query .= "$temp = ?,";
3414 push( @bind, $data->{$temp} );
3415 }
3416
3417 # replace the last , by ",?)"
3418 $query =~ s/\,$//;
3419 my $bkup_sth = $dbh->prepare($query);
3420 $bkup_sth->execute(@bind);
3421 $bkup_sth->finish;
3422
3423 # delete the biblioitem
3424 my $sth2 = $dbh->prepare("DELETE FROM biblioitems WHERE biblioitemnumber=?");
3425 $sth2->execute($biblioitemnumber);
3426 # update the timestamp (Bugzilla 7146)
3427 $sth2= $dbh->prepare("UPDATE deletedbiblioitems SET timestamp=NOW() WHERE biblioitemnumber=?");
3428 $sth2->execute($biblioitemnumber);
3429 $sth2->finish;
3430 }
3431 $sth->finish;
3432 return undef;
3433 }
3434
3435 =head1 UNEXPORTED FUNCTIONS
3436
3437 =head2 ModBiblioMarc
3438
3439 &ModBiblioMarc($newrec,$biblionumber,$frameworkcode);
3440
3441 Add MARC data for a biblio to koha
3442
3443 Function exported, but should NOT be used, unless you really know what you're doing
3444
3445 =cut
3446
3447 sub ModBiblioMarc {
3448
3449 # pass the MARC::Record to this function, and it will create the records in the marc field
3450 my ( $record, $biblionumber, $frameworkcode ) = @_;
3451 my $dbh = C4::Context->dbh;
3452 my @fields = $record->fields();
3453 if ( !$frameworkcode ) {
3454 $frameworkcode = "";
3455 }
3456 my $sth = $dbh->prepare("UPDATE biblio SET frameworkcode=? WHERE biblionumber=?");
3457 $sth->execute( $frameworkcode, $biblionumber );
3458 $sth->finish;
3459 my $encoding = C4::Context->preference("marcflavour");
3460
3461 # deal with UNIMARC field 100 (encoding) : create it if needed & set encoding to unicode
3462 if ( $encoding eq "UNIMARC" ) {
3463 my $string = $record->subfield( 100, "a" );
3464 if ( ($string) && ( length( $record->subfield( 100, "a" ) ) == 36 ) ) {
3465 my $f100 = $record->field(100);
3466 $record->delete_field($f100);
3467 } else {
3468 $string = POSIX::strftime( "%Y%m%d", localtime );
3469 $string =~ s/\-//g;
3470 $string = sprintf( "%-*s", 35, $string );
3471 }
3472 substr( $string, 22, 6, "frey50" );
3473 unless ( $record->subfield( 100, "a" ) ) {
3474 $record->insert_fields_ordered( MARC::Field->new( 100, "", "", "a" => $string ) );
3475 }
3476 }
3477
3478 #enhancement 5374: update transaction date (005) for marc21/unimarc
3479 if($encoding =~ /MARC21|UNIMARC/) {
3480 my @a= (localtime) [5,4,3,2,1,0]; $a[0]+=1900; $a[1]++;
3481 # YY MM DD HH MM SS (update year and month)
3482 my $f005= $record->field('005');
3483 $f005->update(sprintf("%4d%02d%02d%02d%02d%04.1f",@a)) if $f005;
3484 }
3485
3486 my $oldRecord;
3487 if ( C4::Context->preference("NoZebra") ) {
3488
3489 # only NoZebra indexing needs to have
3490 # the previous version of the record
3491 $oldRecord = GetMarcBiblio($biblionumber);
3492 }
3493 $sth = $dbh->prepare("UPDATE biblioitems SET marc=?,marcxml=? WHERE biblionumber=?");
3494 $sth->execute( $record->as_usmarc(), $record->as_xml_record($encoding), $biblionumber );
3495 $sth->finish;
3496 ModZebra( $biblionumber, "specialUpdate", "biblioserver", $oldRecord, $record );
3497 return $biblionumber;
3498 }
3499
3500 =head2 get_biblio_authorised_values
3501
3502 find the types and values for all authorised values assigned to this biblio.
3503
3504 parameters:
3505 biblionumber
3506 MARC::Record of the bib
3507
3508 returns: a hashref mapping the authorised value to the value set for this biblionumber
3509
3510 $authorised_values = {
3511 'Scent' => 'flowery',
3512 'Audience' => 'Young Adult',
3513 'itemtypes' => 'SER',
3514 };
3515
3516 Notes: forlibrarian should probably be passed in, and called something different.
3517
3518 =cut
3519
3520 sub get_biblio_authorised_values {
3521 my $biblionumber = shift;
3522 my $record = shift;
3523
3524 my $forlibrarian = 1; # are we in staff or opac?
3525 my $frameworkcode = GetFrameworkCode($biblionumber);
3526
3527 my $authorised_values;
3528
3529 my $tagslib = GetMarcStructure( $forlibrarian, $frameworkcode )
3530 or return $authorised_values;
3531
3532 # assume that these entries in the authorised_value table are bibliolevel.
3533 # ones that start with 'item%' are item level.
3534 my $query = q(SELECT distinct authorised_value, kohafield
3535 FROM marc_subfield_structure
3536 WHERE authorised_value !=''
3537 AND (kohafield like 'biblio%'
3538 OR kohafield like '') );
3539 my $bibliolevel_authorised_values = C4::Context->dbh->selectall_hashref( $query, 'authorised_value' );
3540
3541 foreach my $tag ( keys(%$tagslib) ) {
3542 foreach my $subfield ( keys( %{ $tagslib->{$tag} } ) ) {
3543
3544 # warn "checking $subfield. type is: " . ref $tagslib->{ $tag }{ $subfield };
3545 if ( 'HASH' eq ref $tagslib->{$tag}{$subfield} ) {
3546 if ( defined $tagslib->{$tag}{$subfield}{'authorised_value'} && exists $bibliolevel_authorised_values->{ $tagslib->{$tag}{$subfield}{'authorised_value'} } ) {
3547 if ( defined $record->field($tag) ) {
3548 my $this_subfield_value = $record->field($tag)->subfield($subfield);
3549 if ( defined $this_subfield_value ) {
3550 $authorised_values->{ $tagslib->{$tag}{$subfield}{'authorised_value'} } = $this_subfield_value;
3551 }
3552 }
3553 }
3554 }
3555 }
3556 }
3557
3558 # warn ( Data::Dumper->Dump( [ $authorised_values ], [ 'authorised_values' ] ) );
3559 return $authorised_values;
3560 }
3561
3562 =head2 CountBiblioInOrders
3563
3564 =over 4
3565 $count = &CountBiblioInOrders( $biblionumber);
3566
3567 =back
3568
3569 This function return count of biblios in orders with $biblionumber
3570
3571 =cut
3572
3573 sub CountBiblioInOrders {
3574 my ($biblionumber) = @_;
3575 my $dbh = C4::Context->dbh;
3576 my $query = "SELECT count(*)
3577 FROM aqorders
3578 WHERE biblionumber=? AND (datecancellationprinted IS NULL OR datecancellationprinted='0000-00-00')";
3579 my $sth = $dbh->prepare($query);
3580 $sth->execute($biblionumber);
3581 my $count = $sth->fetchrow;
3582 return ($count);
3583 }
3584
3585 =head2 GetSubscriptionsId
3586
3587 =over 4
3588 $subscriptions = &GetSubscriptionsId($biblionumber);
3589
3590 =back
3591
3592 This function return an array of subscriptionid with $biblionumber
3593
3594 =cut
3595
3596 sub GetSubscriptionsId {
3597 my ($biblionumber) = @_;
3598 my $dbh = C4::Context->dbh;
3599 my $query = "SELECT subscriptionid
3600 FROM subscription
3601 WHERE biblionumber=?";
3602 my $sth = $dbh->prepare($query);
3603 $sth->execute($biblionumber);
3604 my @subscriptions = $sth->fetchrow_array;
3605 return (@subscriptions);
3606 }
3607
3608 =head2 GetHolds
3609
3610 =over 4
3611 $holds = &GetHolds($biblionumber);
3612
3613 =back
3614
3615 This function return the count of holds with $biblionumber
3616
3617 =cut
3618
3619 sub GetHolds {
3620 my ($biblionumber) = @_;
3621 my $dbh = C4::Context->dbh;
3622 my $query = "SELECT count(*)
3623 FROM reserves
3624 WHERE biblionumber=?";
3625 my $sth = $dbh->prepare($query);
3626 $sth->execute($biblionumber);
3627 my $holds = $sth->fetchrow;
3628 return ($holds);
3629 }
3630
3631
3632 1;
3633
3634 __END__
3635
3636 =head1 AUTHOR
3637
3638 Koha Development Team <http://koha-community.org/>
3639
3640 Paul POULAIN paul.poulain@free.fr
3641
3642 Joshua Ferraro jmf@liblime.com
3643
3644 =cut
Koha ILS