File Coverage

File:	C4/Biblio.pm
Coverage:	2.9%

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