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