← Index
NYTProf Performance Profile   « line view »
For svc/members/upsert
  Run on Tue Jan 13 11:50:22 2015
Reported on Tue Jan 13 12:09:48 2015

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