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