← Index
NYTProf Performance Profile   « block view • line view • sub view »
For /usr/share/koha/opac/cgi-bin/opac/opac-search.pl
  Run on Tue Oct 15 11:58:52 2013
Reported on Tue Oct 15 12:02:12 2013

Filename/usr/share/koha/lib/C4/Biblio.pm
StatementsExecuted 169552 statements in 1.04s
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
2511283ms501msC4::Biblio::::GetMarcStructureC4::Biblio::GetMarcStructure
251131.8ms47.9msC4::Biblio::::TransformMarcToKohaC4::Biblio::TransformMarcToKoha
2951118.0ms790msC4::Biblio::::GetAuthorisedValueDescC4::Biblio::GetAuthorisedValueDesc
100427.64ms232msC4::Biblio::::GetFrameworkCodeC4::Biblio::GetFrameworkCode
1115.08ms24.3msC4::Biblio::::BEGIN@33C4::Biblio::BEGIN@33
75314.94ms166msC4::Biblio::::GetRecordValueC4::Biblio::GetRecordValue
1114.93ms4.94msC4::Biblio::::_get_inverted_marc_field_mapC4::Biblio::_get_inverted_marc_field_map
1114.74ms6.34msC4::Biblio::::BEGIN@37C4::Biblio::BEGIN@37
25113.46ms34.9msC4::Biblio::::GetCOinSBiblioC4::Biblio::GetCOinSBiblio
843113.21ms3.21msC4::Biblio::::_disambiguateC4::Biblio::_disambiguate
25113.11ms579msC4::Biblio::::GetMarcBiblioC4::Biblio::GetMarcBiblio
1112.62ms5.51msC4::Biblio::::BEGIN@27C4::Biblio::BEGIN@27
1112.46ms2.91msC4::Biblio::::BEGIN@39C4::Biblio::BEGIN@39
1112.35ms22.6msC4::Biblio::::BEGIN@29C4::Biblio::BEGIN@29
25112.21ms65.8msC4::Biblio::::CountItemsIssuedC4::Biblio::CountItemsIssued
1111.63ms12.6msC4::Biblio::::BEGIN@28C4::Biblio::BEGIN@28
25111.34ms16.3msC4::Biblio::::_koha_marc_update_bib_idsC4::Biblio::_koha_marc_update_bib_ids
1111.25ms51.6msC4::Biblio::::BEGIN@36C4::Biblio::BEGIN@36
92521.18ms7.53msC4::Biblio::::GetMarcFromKohaFieldC4::Biblio::GetMarcFromKohaField
50211.07ms1.18msC4::Biblio::::CORE:substC4::Biblio::CORE:subst (opcode)
111565µs874µsC4::Biblio::::BEGIN@38C4::Biblio::BEGIN@38
7131290µs290µsC4::Biblio::::CORE:matchC4::Biblio::CORE:match (opcode)
11130µs30µsC4::Biblio::::BEGIN@43C4::Biblio::BEGIN@43
11119µs54µsC4::Biblio::::BEGIN@31C4::Biblio::BEGIN@31
11117µs21µsC4::Biblio::::BEGIN@22C4::Biblio::BEGIN@22
11116µs58µsC4::Biblio::::BEGIN@34C4::Biblio::BEGIN@34
11114µs114µsC4::Biblio::::BEGIN@35C4::Biblio::BEGIN@35
11113µs65µsC4::Biblio::::BEGIN@41C4::Biblio::BEGIN@41
11113µs81µsC4::Biblio::::BEGIN@30C4::Biblio::BEGIN@30
11110µs60µsC4::Biblio::::BEGIN@24C4::Biblio::BEGIN@24
1119µs22µsC4::Biblio::::BEGIN@23C4::Biblio::BEGIN@23
0000s0sC4::Biblio::::AddBiblioC4::Biblio::AddBiblio
0000s0sC4::Biblio::::BiblioAutoLinkC4::Biblio::BiblioAutoLink
0000s0sC4::Biblio::::CountBiblioInOrdersC4::Biblio::CountBiblioInOrders
0000s0sC4::Biblio::::DelBiblioC4::Biblio::DelBiblio
0000s0sC4::Biblio::::DeleteFieldMappingC4::Biblio::DeleteFieldMapping
0000s0sC4::Biblio::::EmbedItemsInMarcBiblioC4::Biblio::EmbedItemsInMarcBiblio
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::::GetFieldMappingC4::Biblio::GetFieldMapping
0000s0sC4::Biblio::::GetHoldsC4::Biblio::GetHolds
0000s0sC4::Biblio::::GetISBDViewC4::Biblio::GetISBDView
0000s0sC4::Biblio::::GetMarcAuthorsC4::Biblio::GetMarcAuthors
0000s0sC4::Biblio::::GetMarcControlnumberC4::Biblio::GetMarcControlnumber
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::::GetMarcSubfieldStructureFromKohaFieldC4::Biblio::GetMarcSubfieldStructureFromKohaField
0000s0sC4::Biblio::::GetMarcSubjectsC4::Biblio::GetMarcSubjects
0000s0sC4::Biblio::::GetMarcUrlsC4::Biblio::GetMarcUrls
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::::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::::_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_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
22326µs224µs
# spent 21µs (17+4) within C4::Biblio::BEGIN@22 which was called: # once (17µs+4µs) by C4::Reserves::BEGIN@27 at line 22
use strict;
# spent 21µs making 1 call to C4::Biblio::BEGIN@22 # spent 4µs making 1 call to strict::import
23325µs235µs
# spent 22µs (9+13) within C4::Biblio::BEGIN@23 which was called: # once (9µs+13µs) by C4::Reserves::BEGIN@27 at line 23
use warnings;
# spent 22µs making 1 call to C4::Biblio::BEGIN@23 # spent 13µs making 1 call to warnings::import
24332µs2110µs
# spent 60µs (10+50) within C4::Biblio::BEGIN@24 which was called: # once (10µs+50µs) by C4::Reserves::BEGIN@27 at line 24
use Carp;
# spent 60µs making 1 call to C4::Biblio::BEGIN@24 # spent 50µs making 1 call to Exporter::import
25
26# use utf8;
273141µs25.54ms
# spent 5.51ms (2.62+2.89) within C4::Biblio::BEGIN@27 which was called: # once (2.62ms+2.89ms) by C4::Reserves::BEGIN@27 at line 27
use MARC::Record;
# spent 5.51ms making 1 call to C4::Biblio::BEGIN@27 # spent 31µs making 1 call to Exporter::import
283138µs112.6ms
# spent 12.6ms (1.63+11.0) within C4::Biblio::BEGIN@28 which was called: # once (1.63ms+11.0ms) by C4::Reserves::BEGIN@27 at line 28
use MARC::File::USMARC;
# spent 12.6ms making 1 call to C4::Biblio::BEGIN@28
293138µs222.6ms
# spent 22.6ms (2.35+20.2) within C4::Biblio::BEGIN@29 which was called: # once (2.35ms+20.2ms) by C4::Reserves::BEGIN@27 at line 29
use MARC::File::XML;
# spent 22.6ms making 1 call to C4::Biblio::BEGIN@29 # spent 6µs making 1 call to MARC::File::XML::import
30336µs2149µs
# spent 81µs (13+68) within C4::Biblio::BEGIN@30 which was called: # once (13µs+68µs) by C4::Reserves::BEGIN@27 at line 30
use POSIX qw(strftime);
# spent 81µs making 1 call to C4::Biblio::BEGIN@30 # spent 68µs making 1 call to POSIX::import
31336µs288µs
# spent 54µs (19+35) within C4::Biblio::BEGIN@31 which was called: # once (19µs+35µs) by C4::Reserves::BEGIN@27 at line 31
use Module::Load::Conditional qw(can_load);
# spent 54µs making 1 call to C4::Biblio::BEGIN@31 # spent 35µs making 1 call to Exporter::import
32
333145µs224.7ms
# spent 24.3ms (5.08+19.2) within C4::Biblio::BEGIN@33 which was called: # once (5.08ms+19.2ms) by C4::Reserves::BEGIN@27 at line 33
use C4::Koha;
# spent 24.3ms making 1 call to C4::Biblio::BEGIN@33 # spent 412µs making 1 call to Exporter::import
34333µs2100µs
# spent 58µs (16+42) within C4::Biblio::BEGIN@34 which was called: # once (16µs+42µs) by C4::Reserves::BEGIN@27 at line 34
use C4::Dates qw/format_date/;
# spent 58µs making 1 call to C4::Biblio::BEGIN@34 # spent 42µs making 1 call to Exporter::import
35336µs2213µs
# spent 114µs (14+100) within C4::Biblio::BEGIN@35 which was called: # once (14µs+100µs) by C4::Reserves::BEGIN@27 at line 35
use C4::Log; # logaction
# spent 114µs making 1 call to C4::Biblio::BEGIN@35 # spent 100µs making 1 call to Exporter::import
363138µs251.8ms
# spent 51.6ms (1.25+50.4) within C4::Biblio::BEGIN@36 which was called: # once (1.25ms+50.4ms) by C4::Reserves::BEGIN@27 at line 36
use C4::ClassSource;
# spent 51.6ms making 1 call to C4::Biblio::BEGIN@36 # spent 186µs making 1 call to Exporter::import
373162µs26.64ms
# spent 6.34ms (4.74+1.60) within C4::Biblio::BEGIN@37 which was called: # once (4.74ms+1.60ms) by C4::Reserves::BEGIN@27 at line 37
use C4::Charset;
# spent 6.34ms making 1 call to C4::Biblio::BEGIN@37 # spent 299µs making 1 call to Exporter::import
383135µs2881µs
# spent 874µs (565+309) within C4::Biblio::BEGIN@38 which was called: # once (565µs+309µs) by C4::Reserves::BEGIN@27 at line 38
use C4::Linker;
# spent 874µs making 1 call to C4::Biblio::BEGIN@38 # spent 7µs making 1 call to Class::Accessor::import
393154µs23.14ms
# spent 2.91ms (2.46+448µs) within C4::Biblio::BEGIN@39 which was called: # once (2.46ms+448µs) by C4::Reserves::BEGIN@27 at line 39
use C4::OAI::Sets;
# spent 2.91ms making 1 call to C4::Biblio::BEGIN@39 # spent 230µs making 1 call to Exporter::import
40
413192µs2117µs
# spent 65µs (13+52) within C4::Biblio::BEGIN@41 which was called: # once (13µs+52µs) by C4::Reserves::BEGIN@27 at line 41
use vars qw($VERSION @ISA @EXPORT);
# spent 65µs making 1 call to C4::Biblio::BEGIN@41 # spent 52µs making 1 call to vars::import
42
43
# spent 30µs within C4::Biblio::BEGIN@43 which was called: # once (30µs+0s) by C4::Reserves::BEGIN@27 at line 141
BEGIN {
4411µs $VERSION = 3.07.00.049;
45
461700ns require Exporter;
4718µs @ISA = qw( Exporter );
48
49 # to add biblios
50 # EXPORTED FUNCTIONS.
511900ns push @EXPORT, qw(
52 &AddBiblio
53 );
54
55 # to get something
56111µs push @EXPORT, qw(
57 &Get
58 &GetBiblio
59 &GetBiblioData
60 &GetBiblioItemData
61 &GetBiblioItemInfosOf
62 &GetBiblioItemByBiblioNumber
63 &GetBiblioFromItemNumber
64 &GetBiblionumberFromItemnumber
65
66 &GetRecordValue
67 &GetFieldMapping
68 &SetFieldMapping
69 &DeleteFieldMapping
70
71 &GetISBDView
72
73 &GetMarcControlnumber
74 &GetMarcNotes
75 &GetMarcISBN
76 &GetMarcISSN
77 &GetMarcSubjects
78 &GetMarcBiblio
79 &GetMarcAuthors
80 &GetMarcSeries
81 &GetMarcHosts
82 GetMarcUrls
83 &GetUsedMarcStructure
84 &GetXmlBiblio
85 &GetCOinSBiblio
86 &GetMarcPrice
87 &MungeMarcPrice
88 &GetMarcQuantity
89
90 &GetAuthorisedValueDesc
91 &GetMarcStructure
92 &GetMarcFromKohaField
93 &GetMarcSubfieldStructureFromKohaField
94 &GetFrameworkCode
95 &TransformKohaToMarc
96 &PrepHostMarcField
97
98 &CountItemsIssued
99 &CountBiblioInOrders
100 &GetSubscriptionsId
101 &GetHolds
102 );
103
104 # To modify something
10511µs push @EXPORT, qw(
106 &ModBiblio
107 &ModBiblioframework
108 &ModZebra
109 &UpdateTotalIssues
110 &RemoveAllNsb
111 );
112
113 # To delete something
1141400ns push @EXPORT, qw(
115 &DelBiblio
116 );
117
118 # To link headings in a bib record
119 # to authority records.
1201600ns push @EXPORT, qw(
121 &BiblioAutoLink
122 &LinkBibHeadingsToAuthorities
123 );
124
125 # Internal functions
126 # those functions are exported but should not be used
127 # they are usefull is few circumstances, so are exported.
128 # but don't use them unless you're a core developer ;-)
1291300ns push @EXPORT, qw(
130 &ModBiblioMarc
131 );
132
133 # Others functions
134111µs push @EXPORT, qw(
135 &TransformMarcToKoha
136 &TransformHtmlToMarc2
137 &TransformHtmlToMarc
138 &TransformHtmlToXml
139 prepare_host_field
140 );
141116.1ms130µs}
# spent 30µs making 1 call to C4::Biblio::BEGIN@43
142
14312µseval {
144118µs19µs if (C4::Context->ismemcached) {
# spent 9µs making 1 call to C4::Context::ismemcached
145 require Memoize::Memcached;
146 import Memoize::Memcached qw(memoize_memcached);
147
148 memoize_memcached( 'GetMarcStructure',
149 memcached => C4::Context->memcached);
150 }
151};
152
153=head1 NAME
154
- -
250sub AddBiblio {
251 my $record = shift;
252 my $frameworkcode = shift;
253 my $options = @_ ? shift : undef;
254 my $defer_marc_save = 0;
255 if ( defined $options and exists $options->{'defer_marc_save'} and $options->{'defer_marc_save'} ) {
256 $defer_marc_save = 1;
257 }
258
259 my ( $biblionumber, $biblioitemnumber, $error );
260 my $dbh = C4::Context->dbh;
261
262 # transform the data into koha-table style data
263 SetUTF8Flag($record);
264 my $olddata = TransformMarcToKoha( $dbh, $record, $frameworkcode );
265 ( $biblionumber, $error ) = _koha_add_biblio( $dbh, $olddata, $frameworkcode );
266 $olddata->{'biblionumber'} = $biblionumber;
267 ( $biblioitemnumber, $error ) = _koha_add_biblioitem( $dbh, $olddata );
268
269 _koha_marc_update_bib_ids( $record, $frameworkcode, $biblionumber, $biblioitemnumber );
270
271 # update MARC subfield that stores biblioitems.cn_sort
272 _koha_marc_update_biblioitem_cn_sort( $record, $olddata, $frameworkcode );
273
274 # now add the record
275 ModBiblioMarc( $record, $biblionumber, $frameworkcode ) unless $defer_marc_save;
276
277 # update OAI-PMH sets
278 if(C4::Context->preference("OAI-PMH:AutoUpdateSets")) {
279 C4::OAI::Sets::UpdateOAISetsBiblio($biblionumber, $record);
280 }
281
282 logaction( "CATALOGUING", "ADD", $biblionumber, "biblio" ) if C4::Context->preference("CataloguingLog");
283 return ( $biblionumber, $biblioitemnumber );
284}
285
286=head2 ModBiblio
287
- -
306sub ModBiblio {
307 my ( $record, $biblionumber, $frameworkcode ) = @_;
308 croak "No record" unless $record;
309
310 if ( C4::Context->preference("CataloguingLog") ) {
311 my $newrecord = GetMarcBiblio($biblionumber);
312 logaction( "CATALOGUING", "MODIFY", $biblionumber, "BEFORE=>" . $newrecord->as_formatted );
313 }
314
315 # Cleaning up invalid fields must be done early or SetUTF8Flag is liable to
316 # throw an exception which probably won't be handled.
317 foreach my $field ($record->fields()) {
318 if (! $field->is_control_field()) {
319 if (scalar($field->subfields()) == 0 || (scalar($field->subfields()) == 1 && $field->subfield('9'))) {
320 $record->delete_field($field);
321 }
322 }
323 }
324
325 SetUTF8Flag($record);
326 my $dbh = C4::Context->dbh;
327
328 $frameworkcode = "" if !$frameworkcode || $frameworkcode eq "Default"; # XXX
329
330 _strip_item_fields($record, $frameworkcode);
331
332 # update biblionumber and biblioitemnumber in MARC
333 # FIXME - this is assuming a 1 to 1 relationship between
334 # biblios and biblioitems
335 my $sth = $dbh->prepare("select biblioitemnumber from biblioitems where biblionumber=?");
336 $sth->execute($biblionumber);
337 my ($biblioitemnumber) = $sth->fetchrow;
338 $sth->finish();
339 _koha_marc_update_bib_ids( $record, $frameworkcode, $biblionumber, $biblioitemnumber );
340
341 # load the koha-table data object
342 my $oldbiblio = TransformMarcToKoha( $dbh, $record, $frameworkcode );
343
344 # update MARC subfield that stores biblioitems.cn_sort
345 _koha_marc_update_biblioitem_cn_sort( $record, $oldbiblio, $frameworkcode );
346
347 # update the MARC record (that now contains biblio and items) with the new record data
348 &ModBiblioMarc( $record, $biblionumber, $frameworkcode );
349
350 # modify the other koha tables
351 _koha_modify_biblio( $dbh, $oldbiblio, $frameworkcode );
352 _koha_modify_biblioitem_nonmarc( $dbh, $oldbiblio );
353
354 # update OAI-PMH sets
355 if(C4::Context->preference("OAI-PMH:AutoUpdateSets")) {
356 C4::OAI::Sets::UpdateOAISetsBiblio($biblionumber, $record);
357 }
358
359 return 1;
360}
361
362=head2 _strip_item_fields
363
- -
371sub _strip_item_fields {
372 my $record = shift;
373 my $frameworkcode = shift;
374 # get the items before and append them to the biblio before updating the record, atm we just have the biblio
375 my ( $itemtag, $itemsubfield ) = GetMarcFromKohaField( "items.itemnumber", $frameworkcode );
376
377 # delete any item fields from incoming record to avoid
378 # duplication or incorrect data - use AddItem() or ModItem()
379 # to change items
380 foreach my $field ( $record->field($itemtag) ) {
381 $record->delete_field($field);
382 }
383}
384
385=head2 ModBiblioframework
386
- -
393sub ModBiblioframework {
394 my ( $biblionumber, $frameworkcode ) = @_;
395 my $dbh = C4::Context->dbh;
396 my $sth = $dbh->prepare( "UPDATE biblio SET frameworkcode=? WHERE biblionumber=?" );
397 $sth->execute( $frameworkcode, $biblionumber );
398 return 1;
399}
400
401=head2 DelBiblio
402
- -
414sub DelBiblio {
415 my ($biblionumber) = @_;
416 my $dbh = C4::Context->dbh;
417 my $error; # for error handling
418
419 # First make sure this biblio has no items attached
420 my $sth = $dbh->prepare("SELECT itemnumber FROM items WHERE biblionumber=?");
421 $sth->execute($biblionumber);
422 if ( my $itemnumber = $sth->fetchrow ) {
423
424 # Fix this to use a status the template can understand
425 $error .= "This Biblio has items attached, please delete them first before deleting this biblio ";
426 }
427
428 return $error if $error;
429
430 # We delete attached subscriptions
431 require C4::Serials;
432 my $subscriptions = C4::Serials::GetFullSubscriptionsFromBiblionumber($biblionumber);
433 foreach my $subscription (@$subscriptions) {
434 C4::Serials::DelSubscription( $subscription->{subscriptionid} );
435 }
436
437 # We delete any existing holds
438 require C4::Reserves;
439 my ($count, $reserves) = C4::Reserves::GetReservesFromBiblionumber($biblionumber);
440 foreach my $res ( @$reserves ) {
441 C4::Reserves::CancelReserve( $res->{'biblionumber'}, $res->{'itemnumber'}, $res->{'borrowernumber'} );
442 }
443
444 # Delete in Zebra. Be careful NOT to move this line after _koha_delete_biblio
445 # for at least 2 reasons :
446 # - if something goes wrong, the biblio may be deleted from Koha but not from zebra
447 # 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)
448 ModZebra( $biblionumber, "recordDelete", "biblioserver" );
449
450 # delete biblioitems and items from Koha tables and save in deletedbiblioitems,deleteditems
451 $sth = $dbh->prepare("SELECT biblioitemnumber FROM biblioitems WHERE biblionumber=?");
452 $sth->execute($biblionumber);
453 while ( my $biblioitemnumber = $sth->fetchrow ) {
454
455 # delete this biblioitem
456 $error = _koha_delete_biblioitems( $dbh, $biblioitemnumber );
457 return $error if $error;
458 }
459
460 # delete biblio from Koha tables and save in deletedbiblio
461 # must do this *after* _koha_delete_biblioitems, otherwise
462 # delete cascade will prevent deletedbiblioitems rows
463 # from being generated by _koha_delete_biblioitems
464 $error = _koha_delete_biblio( $dbh, $biblionumber );
465
466 logaction( "CATALOGUING", "DELETE", $biblionumber, "" ) if C4::Context->preference("CataloguingLog");
467
468 return;
469}
470
471
472=head2 BiblioAutoLink
473
- -
480sub BiblioAutoLink {
481 my $record = shift;
482 my $frameworkcode = shift;
483 my ( $num_headings_changed, %results );
484
485 my $linker_module =
486 "C4::Linker::" . ( C4::Context->preference("LinkerModule") || 'Default' );
487 unless ( can_load( modules => { $linker_module => undef } ) ) {
488 $linker_module = 'C4::Linker::Default';
489 unless ( can_load( modules => { $linker_module => undef } ) ) {
490 return 0, 0;
491 }
492 }
493
494 my $linker = $linker_module->new(
495 { 'options' => C4::Context->preference("LinkerOptions") } );
496 my ( $headings_changed, undef ) =
497 LinkBibHeadingsToAuthorities( $linker, $record, $frameworkcode, C4::Context->preference("CatalogModuleRelink") || '' );
498 # By default we probably don't want to relink things when cataloging
499 return $headings_changed;
500}
501
502=head2 LinkBibHeadingsToAuthorities
503
- -
521sub LinkBibHeadingsToAuthorities {
522 my $linker = shift;
523 my $bib = shift;
524 my $frameworkcode = shift;
525 my $allowrelink = shift;
526 my %results;
527 require C4::Heading;
528 require C4::AuthoritiesMarc;
529
530 $allowrelink = 1 unless defined $allowrelink;
531 my $num_headings_changed = 0;
532 foreach my $field ( $bib->fields() ) {
533 my $heading = C4::Heading->new_from_bib_field( $field, $frameworkcode );
534 next unless defined $heading;
535
536 # check existing $9
537 my $current_link = $field->subfield('9');
538
539 if ( defined $current_link && (!$allowrelink || !C4::Context->preference('LinkerRelink')) )
540 {
541 $results{'linked'}->{ $heading->display_form() }++;
542 next;
543 }
544
545 my ( $authid, $fuzzy ) = $linker->get_link($heading);
546 if ($authid) {
547 $results{ $fuzzy ? 'fuzzy' : 'linked' }
548 ->{ $heading->display_form() }++;
549 next if defined $current_link and $current_link == $authid;
550
551 $field->delete_subfield( code => '9' ) if defined $current_link;
552 $field->add_subfields( '9', $authid );
553 $num_headings_changed++;
554 }
555 else {
556 if ( defined $current_link
557 && (!$allowrelink || C4::Context->preference('LinkerKeepStale')) )
558 {
559 $results{'fuzzy'}->{ $heading->display_form() }++;
560 }
561 elsif ( C4::Context->preference('AutoCreateAuthorities') ) {
562 if ( _check_valid_auth_link( $current_link, $field ) ) {
563 $results{'linked'}->{ $heading->display_form() }++;
564 }
565 else {
566 my $authtypedata =
567 C4::AuthoritiesMarc::GetAuthType( $heading->auth_type() );
568 my $marcrecordauth = MARC::Record->new();
569 if ( C4::Context->preference('marcflavour') eq 'MARC21' ) {
570 $marcrecordauth->leader(' nz a22 o 4500');
571 SetMarcUnicodeFlag( $marcrecordauth, 'MARC21' );
572 }
573 $field->delete_subfield( code => '9' )
574 if defined $current_link;
575 my $authfield =
576 MARC::Field->new( $authtypedata->{auth_tag_to_report},
577 '', '', "a" => "" . $field->subfield('a') );
578 map {
579 $authfield->add_subfields( $_->[0] => $_->[1] )
580 if ( $_->[0] =~ /[A-z]/ && $_->[0] ne "a" )
581 } $field->subfields();
582 $marcrecordauth->insert_fields_ordered($authfield);
583
584# bug 2317: ensure new authority knows it's using UTF-8; currently
585# only need to do this for MARC21, as MARC::Record->as_xml_record() handles
586# automatically for UNIMARC (by not transcoding)
587# FIXME: AddAuthority() instead should simply explicitly require that the MARC::Record
588# use UTF-8, but as of 2008-08-05, did not want to introduce that kind
589# of change to a core API just before the 3.0 release.
590
591 if ( C4::Context->preference('marcflavour') eq 'MARC21' ) {
592 $marcrecordauth->insert_fields_ordered(
593 MARC::Field->new(
594 '667', '', '',
595 'a' => "Machine generated authority record."
596 )
597 );
598 my $cite =
599 $bib->author() . ", "
600 . $bib->title_proper() . ", "
601 . $bib->publication_date() . " ";
602 $cite =~ s/^[\s\,]*//;
603 $cite =~ s/[\s\,]*$//;
604 $cite =
605 "Work cat.: ("
606 . C4::Context->preference('MARCOrgCode') . ")"
607 . $bib->subfield( '999', 'c' ) . ": "
608 . $cite;
609 $marcrecordauth->insert_fields_ordered(
610 MARC::Field->new( '670', '', '', 'a' => $cite ) );
611 }
612
613 # warn "AUTH RECORD ADDED : ".$marcrecordauth->as_formatted;
614
615 $authid =
616 C4::AuthoritiesMarc::AddAuthority( $marcrecordauth, '',
617 $heading->auth_type() );
618 $field->add_subfields( '9', $authid );
619 $num_headings_changed++;
620 $results{'added'}->{ $heading->display_form() }++;
621 }
622 }
623 elsif ( defined $current_link ) {
624 if ( _check_valid_auth_link( $current_link, $field ) ) {
625 $results{'linked'}->{ $heading->display_form() }++;
626 }
627 else {
628 $field->delete_subfield( code => '9' );
629 $num_headings_changed++;
630 $results{'unlinked'}->{ $heading->display_form() }++;
631 }
632 }
633 else {
634 $results{'unlinked'}->{ $heading->display_form() }++;
635 }
636 }
637
638 }
639 return $num_headings_changed, \%results;
640}
641
642=head2 _check_valid_auth_link
643
- -
655sub _check_valid_auth_link {
656 my ( $authid, $field ) = @_;
657
658 require C4::AuthoritiesMarc;
659
660 my $authorized_heading =
661 C4::AuthoritiesMarc::GetAuthorizedHeading( { 'authid' => $authid } ) || '';
662
663 return ($field->as_string('abcdefghijklmnopqrstuvwxyz') eq $authorized_heading);
664}
665
666=head2 GetRecordValue
667
- -
674
# spent 166ms (4.94+161) within C4::Biblio::GetRecordValue which was called 75 times, avg 2.21ms/call: # 25 times (1.83ms+55.5ms) by C4::Search::searchResults at line 1708 of /usr/share/koha/lib/C4/Search.pm, avg 2.30ms/call # 25 times (1.64ms+53.9ms) by C4::Search::searchResults at line 1709 of /usr/share/koha/lib/C4/Search.pm, avg 2.22ms/call # 25 times (1.47ms+51.3ms) by C4::Search::searchResults at line 1710 of /usr/share/koha/lib/C4/Search.pm, avg 2.11ms/call
sub GetRecordValue {
67575194µs my ( $field, $record, $frameworkcode ) = @_;
67675458µs7573.0ms my $dbh = C4::Context->dbh;
# spent 73.0ms making 75 calls to C4::Context::dbh, avg 974µs/call
677
678751.62ms15015.0ms my $sth = $dbh->prepare('SELECT fieldcode, subfieldcode FROM fieldmapping WHERE frameworkcode = ? AND field = ?');
# spent 8.09ms making 75 calls to DBI::db::prepare, avg 108µs/call # spent 6.88ms making 75 calls to DBD::mysql::db::prepare, avg 92µs/call
6797576.2ms7575.3ms $sth->execute( $frameworkcode, $field );
# spent 75.3ms making 75 calls to DBI::st::execute, avg 1.00ms/call
680
68175184µs my @result = ();
682
683753.99ms2254.90ms while ( my $row = $sth->fetchrow_hashref ) {
# spent 3.40ms making 75 calls to DBI::st::fetchrow_hashref, avg 45µs/call # spent 834µs making 75 calls to DBI::common::FETCH, avg 11µs/call # spent 665µs making 75 calls to DBI::st::fetch, avg 9µs/call
684 foreach my $field ( $record->field( $row->{fieldcode} ) ) {
685 if ( ( $row->{subfieldcode} ne "" && $field->subfield( $row->{subfieldcode} ) ) ) {
686 foreach my $subfield ( $field->subfield( $row->{subfieldcode} ) ) {
687 push @result, { 'subfield' => $subfield };
688 }
689
690 } elsif ( $row->{subfieldcode} eq "" ) {
691 push @result, { 'subfield' => $field->as_string() };
692 }
693 }
694 }
695
696752.99ms return \@result;
697}
698
699=head2 SetFieldMapping
700
- -
707sub SetFieldMapping {
708 my ( $framework, $field, $fieldcode, $subfieldcode ) = @_;
709 my $dbh = C4::Context->dbh;
710
711 my $sth = $dbh->prepare('SELECT * FROM fieldmapping WHERE fieldcode = ? AND subfieldcode = ? AND frameworkcode = ? AND field = ?');
712 $sth->execute( $fieldcode, $subfieldcode, $framework, $field );
713 if ( not $sth->fetchrow_hashref ) {
714 my @args;
715 $sth = $dbh->prepare('INSERT INTO fieldmapping (fieldcode, subfieldcode, frameworkcode, field) VALUES(?,?,?,?)');
716
717 $sth->execute( $fieldcode, $subfieldcode, $framework, $field );
718 }
719}
720
721=head2 DeleteFieldMapping
722
- -
729sub DeleteFieldMapping {
730 my ($id) = @_;
731 my $dbh = C4::Context->dbh;
732
733 my $sth = $dbh->prepare('DELETE FROM fieldmapping WHERE id = ?');
734 $sth->execute($id);
735}
736
737=head2 GetFieldMapping
738
- -
745sub GetFieldMapping {
746 my ($framework) = @_;
747 my $dbh = C4::Context->dbh;
748
749 my $sth = $dbh->prepare('SELECT * FROM fieldmapping where frameworkcode = ?');
750 $sth->execute($framework);
751
752 my @return;
753 while ( my $row = $sth->fetchrow_hashref ) {
754 push @return, $row;
755 }
756 return \@return;
757}
758
759=head2 GetBiblioData
760
- -
775sub GetBiblioData {
776 my ($bibnum) = @_;
777 my $dbh = C4::Context->dbh;
778
779 my $query = " SELECT * , biblioitems.notes AS bnotes, itemtypes.notforloan as bi_notforloan, biblio.notes
780 FROM biblio
781 LEFT JOIN biblioitems ON biblio.biblionumber = biblioitems.biblionumber
782 LEFT JOIN itemtypes ON biblioitems.itemtype = itemtypes.itemtype
783 WHERE biblio.biblionumber = ?";
784
785 my $sth = $dbh->prepare($query);
786 $sth->execute($bibnum);
787 my $data;
788 $data = $sth->fetchrow_hashref;
789 $sth->finish;
790
791 return ($data);
792} # sub GetBiblioData
793
794=head2 &GetBiblioItemData
795
- -
805#'
806sub GetBiblioItemData {
807 my ($biblioitemnumber) = @_;
808 my $dbh = C4::Context->dbh;
809 my $query = "SELECT *,biblioitems.notes AS bnotes
810 FROM biblio LEFT JOIN biblioitems on biblio.biblionumber=biblioitems.biblionumber ";
811 unless ( C4::Context->preference('item-level_itypes') ) {
812 $query .= "LEFT JOIN itemtypes on biblioitems.itemtype=itemtypes.itemtype ";
813 }
814 $query .= " WHERE biblioitemnumber = ? ";
815 my $sth = $dbh->prepare($query);
816 my $data;
817 $sth->execute($biblioitemnumber);
818 $data = $sth->fetchrow_hashref;
819 $sth->finish;
820 return ($data);
821} # sub &GetBiblioItemData
822
823=head2 GetBiblioItemByBiblioNumber
824
- -
829sub GetBiblioItemByBiblioNumber {
830 my ($biblionumber) = @_;
831 my $dbh = C4::Context->dbh;
832 my $sth = $dbh->prepare("Select * FROM biblioitems WHERE biblionumber = ?");
833 my $count = 0;
834 my @results;
835
836 $sth->execute($biblionumber);
837
838 while ( my $data = $sth->fetchrow_hashref ) {
839 push @results, $data;
840 }
841
842 $sth->finish;
843 return @results;
844}
845
846=head2 GetBiblionumberFromItemnumber
847
- -
851sub GetBiblionumberFromItemnumber {
852 my ($itemnumber) = @_;
853 my $dbh = C4::Context->dbh;
854 my $sth = $dbh->prepare("Select biblionumber FROM items WHERE itemnumber = ?");
855
856 $sth->execute($itemnumber);
857 my ($result) = $sth->fetchrow;
858 return ($result);
859}
860
861=head2 GetBiblioFromItemNumber
862
- -
873#'
874sub GetBiblioFromItemNumber {
875 my ( $itemnumber, $barcode ) = @_;
876 my $dbh = C4::Context->dbh;
877 my $sth;
878 if ($itemnumber) {
879 $sth = $dbh->prepare(
880 "SELECT * FROM items
881 LEFT JOIN biblio ON biblio.biblionumber = items.biblionumber
882 LEFT JOIN biblioitems ON biblioitems.biblioitemnumber = items.biblioitemnumber
883 WHERE items.itemnumber = ?"
884 );
885 $sth->execute($itemnumber);
886 } else {
887 $sth = $dbh->prepare(
888 "SELECT * FROM items
889 LEFT JOIN biblio ON biblio.biblionumber = items.biblionumber
890 LEFT JOIN biblioitems ON biblioitems.biblioitemnumber = items.biblioitemnumber
891 WHERE items.barcode = ?"
892 );
893 $sth->execute($barcode);
894 }
895 my $data = $sth->fetchrow_hashref;
896 $sth->finish;
897 return ($data);
898}
899
900=head2 GetISBDView
901
- -
908sub GetISBDView {
909 my ( $biblionumber, $template ) = @_;
910 my $record = GetMarcBiblio($biblionumber, 1);
911 return unless defined $record;
912 my $itemtype = &GetFrameworkCode($biblionumber);
913 my ( $holdingbrtagf, $holdingbrtagsubf ) = &GetMarcFromKohaField( "items.holdingbranch", $itemtype );
914 my $tagslib = &GetMarcStructure( 1, $itemtype );
915
916 my $ISBD = C4::Context->preference('isbd');
917 my $bloc = $ISBD;
918 my $res;
919 my $blocres;
920
921 foreach my $isbdfield ( split( /#/, $bloc ) ) {
922
923 # $isbdfield= /(.?.?.?)/;
924 $isbdfield =~ /(\d\d\d)([^\|])?\|(.*)\|(.*)\|(.*)/;
925 my $fieldvalue = $1 || 0;
926 my $subfvalue = $2 || "";
927 my $textbefore = $3;
928 my $analysestring = $4;
929 my $textafter = $5;
930
931 # warn "==> $1 / $2 / $3 / $4";
932 # my $fieldvalue=substr($isbdfield,0,3);
933 if ( $fieldvalue > 0 ) {
934 my $hasputtextbefore = 0;
935 my @fieldslist = $record->field($fieldvalue);
936 @fieldslist = sort { $a->subfield($holdingbrtagsubf) cmp $b->subfield($holdingbrtagsubf) } @fieldslist if ( $fieldvalue eq $holdingbrtagf );
937
938 # warn "ERROR IN ISBD DEFINITION at : $isbdfield" unless $fieldvalue;
939 # warn "FV : $fieldvalue";
940 if ( $subfvalue ne "" ) {
941 # OPAC hidden subfield
942 next
943 if ( ( $template eq 'opac' )
944 && ( $tagslib->{$fieldvalue}->{$subfvalue}->{'hidden'} || 0 ) > 0 );
945 foreach my $field (@fieldslist) {
946 foreach my $subfield ( $field->subfield($subfvalue) ) {
947 my $calculated = $analysestring;
948 my $tag = $field->tag();
949 if ( $tag < 10 ) {
950 } else {
951 my $subfieldvalue = GetAuthorisedValueDesc( $tag, $subfvalue, $subfield, '', $tagslib );
952 my $tagsubf = $tag . $subfvalue;
953 $calculated =~ s/\{(.?.?.?.?)$tagsubf(.*?)\}/$1$subfieldvalue$2\{$1$tagsubf$2\}/g;
954 if ( $template eq "opac" ) { $calculated =~ s#/cgi-bin/koha/[^/]+/([^.]*.pl\?.*)$#opac-$1#g; }
955
956 # field builded, store the result
957 if ( $calculated && !$hasputtextbefore ) { # put textbefore if not done
958 $blocres .= $textbefore;
959 $hasputtextbefore = 1;
960 }
961
962 # remove punctuation at start
963 $calculated =~ s/^( |;|:|\.|-)*//g;
964 $blocres .= $calculated;
965
966 }
967 }
968 }
969 $blocres .= $textafter if $hasputtextbefore;
970 } else {
971 foreach my $field (@fieldslist) {
972 my $calculated = $analysestring;
973 my $tag = $field->tag();
974 if ( $tag < 10 ) {
975 } else {
976 my @subf = $field->subfields;
977 for my $i ( 0 .. $#subf ) {
978 my $valuecode = $subf[$i][1];
979 my $subfieldcode = $subf[$i][0];
980 # OPAC hidden subfield
981 next
982 if ( ( $template eq 'opac' )
983 && ( $tagslib->{$fieldvalue}->{$subfieldcode}->{'hidden'} || 0 ) > 0 );
984 my $subfieldvalue = GetAuthorisedValueDesc( $tag, $subf[$i][0], $subf[$i][1], '', $tagslib );
985 my $tagsubf = $tag . $subfieldcode;
986
987 $calculated =~ s/ # replace all {{}} codes by the value code.
988 \{\{$tagsubf\}\} # catch the {{actualcode}}
989 /
990 $valuecode # replace by the value code
991 /gx;
992
993 $calculated =~ s/\{(.?.?.?.?)$tagsubf(.*?)\}/$1$subfieldvalue$2\{$1$tagsubf$2\}/g;
994 if ( $template eq "opac" ) { $calculated =~ s#/cgi-bin/koha/[^/]+/([^.]*.pl\?.*)$#opac-$1#g; }
995 }
996
997 # field builded, store the result
998 if ( $calculated && !$hasputtextbefore ) { # put textbefore if not done
999 $blocres .= $textbefore;
1000 $hasputtextbefore = 1;
1001 }
1002
1003 # remove punctuation at start
1004 $calculated =~ s/^( |;|:|\.|-)*//g;
1005 $blocres .= $calculated;
1006 }
1007 }
1008 $blocres .= $textafter if $hasputtextbefore;
1009 }
1010 } else {
1011 $blocres .= $isbdfield;
1012 }
1013 }
1014 $res .= $blocres;
1015
1016 $res =~ s/\{(.*?)\}//g;
1017 $res =~ s/\\n/\n/g;
1018 $res =~ s/\n/<br\/>/g;
1019
1020 # remove empty ()
1021 $res =~ s/\(\)//g;
1022
1023 return $res;
1024}
1025
1026=head2 GetBiblio
1027
- -
1032sub GetBiblio {
1033 my ($biblionumber) = @_;
1034 my $dbh = C4::Context->dbh;
1035 my $sth = $dbh->prepare("SELECT * FROM biblio WHERE biblionumber = ?");
1036 my $count = 0;
1037 my @results;
1038 $sth->execute($biblionumber);
1039 if ( my $data = $sth->fetchrow_hashref ) {
1040 return $data;
1041 }
1042 return;
1043} # sub GetBiblio
1044
1045=head2 GetBiblioItemInfosOf
1046
- -
1051sub GetBiblioItemInfosOf {
1052 my @biblioitemnumbers = @_;
1053
1054 my $query = '
1055 SELECT biblioitemnumber,
1056 publicationyear,
1057 itemtype
1058 FROM biblioitems
1059 WHERE biblioitemnumber IN (' . join( ',', @biblioitemnumbers ) . ')
1060 ';
1061 return get_infos_of( $query, 'biblioitemnumber' );
1062}
1063
1064=head1 FUNCTIONS FOR HANDLING MARC MANAGEMENT
1065
- -
1076# cache for results of GetMarcStructure -- needed
1077# for batch jobs
10781500nsour $marc_structure_cache;
1079
1080
# spent 501ms (283+218) within C4::Biblio::GetMarcStructure which was called 25 times, avg 20.0ms/call: # 25 times (283ms+218ms) by C4::XSLT::transformMARCXML4XSLT at line 78 of /usr/share/koha/lib/C4/XSLT.pm, avg 20.0ms/call
sub GetMarcStructure {
10812550µs my ( $forlibrarian, $frameworkcode ) = @_;
108225174µs2524.2ms my $dbh = C4::Context->dbh;
# spent 24.2ms making 25 calls to C4::Context::dbh, avg 968µs/call
10832522µs $frameworkcode = "" unless $frameworkcode;
1084
108525327µs if ( defined $marc_structure_cache and exists $marc_structure_cache->{$forlibrarian}->{$frameworkcode} ) {
1086 return $marc_structure_cache->{$forlibrarian}->{$frameworkcode};
1087 }
1088
1089 # my $sth = $dbh->prepare(
1090 # "SELECT COUNT(*) FROM marc_tag_structure WHERE frameworkcode=?");
1091 # $sth->execute($frameworkcode);
1092 # my ($total) = $sth->fetchrow;
1093 # $frameworkcode = "" unless ( $total > 0 );
1094348µs6371µs my $sth = $dbh->prepare(
# spent 204µs making 3 calls to DBI::db::prepare, avg 68µs/call # spent 168µs making 3 calls to DBD::mysql::db::prepare, avg 56µs/call
1095 "SELECT tagfield,liblibrarian,libopac,mandatory,repeatable
1096 FROM marc_tag_structure
1097 WHERE frameworkcode=?
1098 ORDER BY tagfield"
1099 );
110037.51ms37.44ms $sth->execute($frameworkcode);
# spent 7.44ms making 3 calls to DBI::st::execute, avg 2.48ms/call
110135µs my ( $liblibrarian, $libopac, $tag, $res, $tab, $mandatory, $repeatable );
1102
1103383µs347µs while ( ( $tag, $liblibrarian, $libopac, $mandatory, $repeatable ) = $sth->fetchrow ) {
# spent 47µs making 3 calls to DBI::st::fetchrow, avg 16µs/call
11048902.27ms $res->{$tag}->{lib} = ( $forlibrarian or !$libopac ) ? $liblibrarian : $libopac;
1105890811µs $res->{$tag}->{tab} = "";
1106890801µs $res->{$tag}->{mandatory} = $mandatory;
110789011.1ms8904.90ms $res->{$tag}->{repeatable} = $repeatable;
# spent 4.90ms making 890 calls to DBI::st::fetchrow, avg 6µs/call
1108 }
1109
11103192µs6833µs $sth = $dbh->prepare(
# spent 441µs making 3 calls to DBI::db::prepare, avg 147µs/call # spent 393µs making 3 calls to DBD::mysql::db::prepare, avg 131µs/call
1111 "SELECT tagfield,tagsubfield,liblibrarian,libopac,tab,mandatory,repeatable,authorised_value,authtypecode,value_builder,kohafield,seealso,hidden,isurl,link,defaultvalue,maxlength
1112 FROM marc_subfield_structure
1113 WHERE frameworkcode=?
1114 ORDER BY tagfield,tagsubfield
1115 "
1116 );
1117
11183107ms12107ms $sth->execute($frameworkcode);
# spent 107ms making 3 calls to DBI::st::execute, avg 35.6ms/call # spent 34µs making 6 calls to DBI::common::DESTROY, avg 6µs/call # spent 14µs making 3 calls to DBD::_mem::common::DESTROY, avg 5µs/call
1119
112035µs my $subfield;
112131µs my $authorised_value;
112231µs my $authtypecode;
112331µs my $value_builder;
112431µs my $kohafield;
112531µs my $seealso;
112632µs my $hidden;
11273800ns my $isurl;
11283900ns my $link;
11293900ns my $defaultvalue;
113031µs my $maxlength;
1131
11323247µs3144µs while (
# spent 144µs making 3 calls to DBI::st::fetchrow, avg 48µs/call
1133 ( $tag, $subfield, $liblibrarian, $libopac, $tab, $mandatory, $repeatable, $authorised_value,
1134 $authtypecode, $value_builder, $kohafield, $seealso, $hidden, $isurl, $link, $defaultvalue,
1135 $maxlength
1136 )
1137 = $sth->fetchrow
1138 ) {
11391041626.3ms $res->{$tag}->{$subfield}->{lib} = ( $forlibrarian or !$libopac ) ? $liblibrarian : $libopac;
11401041610.1ms $res->{$tag}->{$subfield}->{tab} = $tab;
11411041610.5ms $res->{$tag}->{$subfield}->{mandatory} = $mandatory;
11421041610.1ms $res->{$tag}->{$subfield}->{repeatable} = $repeatable;
1143104169.81ms $res->{$tag}->{$subfield}->{authorised_value} = $authorised_value;
11441041610.9ms $res->{$tag}->{$subfield}->{authtypecode} = $authtypecode;
11451041610.0ms $res->{$tag}->{$subfield}->{value_builder} = $value_builder;
11461041615.7ms $res->{$tag}->{$subfield}->{kohafield} = $kohafield;
1147104169.19ms $res->{$tag}->{$subfield}->{seealso} = $seealso;
11481041610.3ms $res->{$tag}->{$subfield}->{hidden} = $hidden;
11491041610.1ms $res->{$tag}->{$subfield}->{isurl} = $isurl;
1150104169.37ms $res->{$tag}->{$subfield}->{'link'} = $link;
11511041610.5ms $res->{$tag}->{$subfield}->{defaultvalue} = $defaultvalue;
115210416192ms1041673.8ms $res->{$tag}->{$subfield}->{maxlength} = $maxlength;
# spent 73.8ms making 10416 calls to DBI::st::fetchrow, avg 7µs/call
1153 }
1154
1155315µs $marc_structure_cache->{$forlibrarian}->{$frameworkcode} = $res;
1156
11573244µs return $res;
1158}
1159
1160=head2 GetUsedMarcStructure
1161
- -
1174sub GetUsedMarcStructure {
1175 my $frameworkcode = shift || '';
1176 my $query = qq/
1177 SELECT *
1178 FROM marc_subfield_structure
1179 WHERE tab > -1
1180 AND frameworkcode = ?
1181 ORDER BY tagfield, tagsubfield
1182 /;
1183 my $sth = C4::Context->dbh->prepare($query);
1184 $sth->execute($frameworkcode);
1185 return $sth->fetchall_arrayref( {} );
1186}
1187
1188=head2 GetMarcFromKohaField
1189
- -
1197
# spent 7.53ms (1.18+6.35) within C4::Biblio::GetMarcFromKohaField which was called 92 times, avg 82µs/call: # 40 times (429µs+173µs) by C4::Search::searchResults at line 1681 of /usr/share/koha/lib/C4/Search.pm, avg 15µs/call # 25 times (495µs+210µs) by C4::Biblio::_koha_marc_update_bib_ids at line 2846, avg 28µs/call # 25 times (214µs+68µs) by C4::Biblio::_koha_marc_update_bib_ids at line 2848, avg 11µs/call # once (31µs+5.89ms) by C4::Search::searchResults at line 1674 of /usr/share/koha/lib/C4/Search.pm # once (8µs+4µs) by C4::Search::searchResults at line 1697 of /usr/share/koha/lib/C4/Search.pm
sub GetMarcFromKohaField {
11989278µs my $kohafield = shift;
11999255µs my $frameworkcode = shift || '';
12009223µs return (0, undef) unless $kohafield;
120192308µs926.35ms my $relations = C4::Context->marcfromkohafield;
# spent 6.35ms making 92 calls to C4::Context::marcfromkohafield, avg 69µs/call
120292637µs if ( my $mf = $relations->{$frameworkcode}->{$kohafield} ) {
1203 return @$mf;
1204 }
1205614µs return (0, undef);
1206}
1207
1208=head2 GetMarcSubfieldStructureFromKohaField
1209
- -
1219sub GetMarcSubfieldStructureFromKohaField {
1220 my ($kohafield, $frameworkcode) = @_;
1221
1222 return undef unless $kohafield;
1223 $frameworkcode //= '';
1224
1225 my $dbh = C4::Context->dbh;
1226 my $query = qq{
1227 SELECT *
1228 FROM marc_subfield_structure
1229 WHERE kohafield = ?
1230 AND frameworkcode = ?
1231 };
1232 my $sth = $dbh->prepare($query);
1233 $sth->execute($kohafield, $frameworkcode);
1234 my $result = $sth->fetchrow_hashref;
1235 $sth->finish;
1236
1237 return $result;
1238}
1239
1240=head2 GetMarcBiblio
1241
- -
1251
# spent 579ms (3.11+576) within C4::Biblio::GetMarcBiblio which was called 25 times, avg 23.1ms/call: # 25 times (3.11ms+576ms) by main::RUNTIME at line 588 of /usr/share/koha/opac/cgi-bin/opac/opac-search.pl, avg 23.1ms/call
sub GetMarcBiblio {
12522530µs my $biblionumber = shift;
12532524µs my $embeditems = shift || 0;
125425128µs2527.1ms my $dbh = C4::Context->dbh;
# spent 27.1ms making 25 calls to C4::Context::dbh, avg 1.08ms/call
125525532µs505.01ms my $sth = $dbh->prepare("SELECT marcxml FROM biblioitems WHERE biblionumber=? ");
# spent 2.69ms making 25 calls to DBI::db::prepare, avg 108µs/call # spent 2.32ms making 25 calls to DBD::mysql::db::prepare, avg 93µs/call
12562539.5ms2539.2ms $sth->execute($biblionumber);
# spent 39.2ms making 25 calls to DBI::st::execute, avg 1.57ms/call
1257251.76ms752.41ms my $row = $sth->fetchrow_hashref;
# spent 1.57ms making 25 calls to DBI::st::fetchrow_hashref, avg 63µs/call # spent 582µs making 25 calls to DBI::st::fetch, avg 23µs/call # spent 261µs making 25 calls to DBI::common::FETCH, avg 10µs/call
125825204µs2510.1ms my $marcxml = StripNonXmlChars( $row->{'marcxml'} );
# spent 10.1ms making 25 calls to C4::Charset::StripNonXmlChars, avg 402µs/call
125925311µs50413µs MARC::File::XML->default_record_format( C4::Context->preference('marcflavour') );
# spent 213µs making 25 calls to C4::Context::preference, avg 9µs/call # spent 201µs making 25 calls to MARC::File::XML::default_record_format, avg 8µs/call
126025174µs25449µs my $record = MARC::Record->new();
# spent 449µs making 25 calls to MARC::Record::new, avg 18µs/call
1261
12622520µs if ($marcxml) {
126350358µs50477ms $record = eval { MARC::Record::new_from_xml( $marcxml, "utf8", C4::Context->preference('marcflavour') ) };
# spent 477ms making 25 calls to MARC::Record::new_from_xml, avg 19.1ms/call # spent 102µs making 25 calls to C4::Context::preference, avg 4µs/call
12642517µs if ($@) { warn " problem with :$biblionumber : $@ \n$marcxml"; }
12652513µs return unless $record;
1266
126725180µs2516.3ms C4::Biblio::_koha_marc_update_bib_ids($record, '', $biblionumber, $biblionumber);
# spent 16.3ms making 25 calls to C4::Biblio::_koha_marc_update_bib_ids, avg 652µs/call
12682512µs C4::Biblio::EmbedItemsInMarcBiblio($record, $biblionumber) if ($embeditems);
1269
1270251.81ms return $record;
1271 } else {
1272 return;
1273 }
1274}
1275
1276=head2 GetXmlBiblio
1277
- -
1285sub GetXmlBiblio {
1286 my ($biblionumber) = @_;
1287 my $dbh = C4::Context->dbh;
1288 my $sth = $dbh->prepare("SELECT marcxml FROM biblioitems WHERE biblionumber=? ");
1289 $sth->execute($biblionumber);
1290 my ($marcxml) = $sth->fetchrow;
1291 return $marcxml;
1292}
1293
1294=head2 GetCOinSBiblio
1295
- -
1302
# spent 34.9ms (3.46+31.4) within C4::Biblio::GetCOinSBiblio which was called 25 times, avg 1.40ms/call: # 25 times (3.46ms+31.4ms) by main::RUNTIME at line 589 of /usr/share/koha/opac/cgi-bin/opac/opac-search.pl, avg 1.40ms/call
sub GetCOinSBiblio {
13032518µs my $record = shift;
1304
1305 # get the coin format
13062516µs if ( ! $record ) {
1307 return;
1308 }
130925170µs25128µs my $pos7 = substr $record->leader(), 7, 1;
# spent 128µs making 25 calls to MARC::Record::leader, avg 5µs/call
13102581µs2567µs my $pos6 = substr $record->leader(), 6, 1;
# spent 67µs making 25 calls to MARC::Record::leader, avg 3µs/call
1311259µs my $mtx;
1312257µs my $genre;
13132533µs my ( $aulast, $aufirst ) = ( '', '' );
13142515µs my $oauthors = '';
13152511µs my $title = '';
13162513µs my $subtitle = '';
1317258µs my $pubyear = '';
13182514µs my $isbn = '';
13192512µs my $issn = '';
1320256µs my $publisher = '';
13212512µs my $pages = '';
1322256µs my $titletype = 'b';
1323
1324 # For the purposes of generating COinS metadata, LDR/06-07 can be
1325 # considered the same for UNIMARC and MARC21
1326254µs my $fmts6;
1327259µs my $fmts7;
132825497µs %$fmts6 = (
1329 'a' => 'book',
1330 'b' => 'manuscript',
1331 'c' => 'book',
1332 'd' => 'manuscript',
1333 'e' => 'map',
1334 'f' => 'map',
1335 'g' => 'film',
1336 'i' => 'audioRecording',
1337 'j' => 'audioRecording',
1338 'k' => 'artwork',
1339 'l' => 'document',
1340 'm' => 'computerProgram',
1341 'o' => 'document',
1342 'r' => 'document',
1343 );
13442582µs %$fmts7 = (
1345 'a' => 'journalArticle',
1346 's' => 'journal',
1347 );
1348
13492533µs $genre = $fmts6->{$pos6} ? $fmts6->{$pos6} : 'book';
1350
13512543µs if ( $genre eq 'book' ) {
1352 $genre = $fmts7->{$pos7} if $fmts7->{$pos7};
1353 }
1354
1355 ##### We must transform mtx to a valable mtx and document type ####
13562529µs if ( $genre eq 'book' ) {
1357 $mtx = 'book';
1358 } elsif ( $genre eq 'journal' ) {
135916µs $mtx = 'journal';
13601600ns $titletype = 'j';
1361 } elsif ( $genre eq 'journalArticle' ) {
13621500ns $mtx = 'journal';
13631400ns $genre = 'article';
13641600ns $titletype = 'a';
1365 } else {
1366 $mtx = 'dc';
1367 }
1368
13692550µs $genre = ( $mtx eq 'dc' ) ? "&amp;rft.type=$genre" : "&amp;rft.genre=$genre";
1370
137125159µs25232µs if ( C4::Context->preference("marcflavour") eq "UNIMARC" ) {
# spent 232µs making 25 calls to C4::Context::preference, avg 9µs/call
1372
1373 # Setting datas
1374 $aulast = $record->subfield( '700', 'a' ) || '';
1375 $aufirst = $record->subfield( '700', 'b' ) || '';
1376 $oauthors = "&amp;rft.au=$aufirst $aulast";
1377
1378 # others authors
1379 if ( $record->field('200') ) {
1380 for my $au ( $record->field('200')->subfield('g') ) {
1381 $oauthors .= "&amp;rft.au=$au";
1382 }
1383 }
1384 $title =
1385 ( $mtx eq 'dc' )
1386 ? "&amp;rft.title=" . $record->subfield( '200', 'a' )
1387 : "&amp;rft.title=" . $record->subfield( '200', 'a' ) . "&amp;rft.btitle=" . $record->subfield( '200', 'a' );
1388 $pubyear = $record->subfield( '210', 'd' ) || '';
1389 $publisher = $record->subfield( '210', 'c' ) || '';
1390 $isbn = $record->subfield( '010', 'a' ) || '';
1391 $issn = $record->subfield( '011', 'a' ) || '';
1392 } else {
1393
1394 # MARC21 need some improve
1395
1396 # Setting datas
139725148µs364.74ms if ( $record->field('100') ) {
# spent 3.67ms making 25 calls to MARC::Record::field, avg 147µs/call # spent 1.07ms making 11 calls to MARC::Record::subfield, avg 97µs/call
1398 $oauthors .= "&amp;rft.au=" . $record->subfield( '100', 'a' );
1399 }
1400
1401 # others authors
140225146µs435.54ms if ( $record->field('700') ) {
# spent 5.33ms making 34 calls to MARC::Record::field, avg 157µs/call # spent 205µs making 9 calls to MARC::Field::subfield, avg 23µs/call
1403 for my $au ( $record->field('700')->subfield('a') ) {
1404923µs $oauthors .= "&amp;rft.au=$au";
1405 }
1406 }
140725138µs252.35ms $title = "&amp;rft." . $titletype . "title=" . $record->subfield( '245', 'a' );
# spent 2.35ms making 25 calls to MARC::Record::subfield, avg 94µs/call
14082588µs252.15ms $subtitle = $record->subfield( '245', 'b' ) || '';
# spent 2.15ms making 25 calls to MARC::Record::subfield, avg 86µs/call
14092532µs $title .= $subtitle;
14102543µs if ($titletype eq 'a') {
141113µs1342µs $pubyear = $record->field('008') || '';
# spent 342µs making 1 call to MARC::Record::field
14121500ns $pubyear = substr($pubyear->data(), 7, 4) if $pubyear;
141313µs1205µs $isbn = $record->subfield( '773', 'z' ) || '';
# spent 205µs making 1 call to MARC::Record::subfield
141413µs1191µs $issn = $record->subfield( '773', 'x' ) || '';
# spent 191µs making 1 call to MARC::Record::subfield
141517µs1190µs if ($mtx eq 'journal') {
# spent 190µs making 1 call to MARC::Record::subfield
1416 $title .= "&amp;rft.title=" . (($record->subfield( '773', 't' ) || $record->subfield( '773', 'a')));
1417 } else {
1418 $title .= "&amp;rft.btitle=" . (($record->subfield( '773', 't' ) || $record->subfield( '773', 'a')) || '');
1419 }
142014µs1190µs foreach my $rel ($record->subfield( '773', 'g' )) {
# spent 190µs making 1 call to MARC::Record::subfield
1421 if ($pages) {
1422 $pages .= ', ';
1423 }
1424 $pages .= $rel;
1425 }
1426 } else {
14272481µs242.29ms $pubyear = $record->subfield( '260', 'c' ) || '';
# spent 2.29ms making 24 calls to MARC::Record::subfield, avg 96µs/call
14282480µs242.18ms $publisher = $record->subfield( '260', 'b' ) || '';
# spent 2.18ms making 24 calls to MARC::Record::subfield, avg 91µs/call
14292480µs245.05ms $isbn = $record->subfield( '020', 'a' ) || '';
# spent 5.05ms making 24 calls to MARC::Record::subfield, avg 210µs/call
14302472µs244.42ms $issn = $record->subfield( '022', 'a' ) || '';
# spent 4.42ms making 24 calls to MARC::Record::subfield, avg 184µs/call
1431 }
1432
1433 }
143425226µs my $coins_value =
1435"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";
1436251.12ms261.23ms $coins_value =~ s/(\ |&[^a])/\+/g;
# spent 1.13ms making 25 calls to C4::Biblio::CORE:subst, avg 45µs/call # spent 110µs making 1 call to utf8::SWASHNEW
143725118µs2555µs $coins_value =~ s/\"/\&quot\;/g;
# spent 55µs making 25 calls to C4::Biblio::CORE:subst, avg 2µs/call
1438
1439#<!-- 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="
1440
144125238µs return $coins_value;
1442}
1443
1444
1445=head2 GetMarcPrice
1446
- -
1450sub GetMarcPrice {
1451 my ( $record, $marcflavour ) = @_;
1452 my @listtags;
1453 my $subfield;
1454
1455 if ( $marcflavour eq "MARC21" ) {
1456 @listtags = ('345', '020');
1457 $subfield="c";
1458 } elsif ( $marcflavour eq "UNIMARC" ) {
1459 @listtags = ('345', '010');
1460 $subfield="d";
1461 } else {
1462 return;
1463 }
1464
1465 for my $field ( $record->field(@listtags) ) {
1466 for my $subfield_value ($field->subfield($subfield)){
1467 #check value
1468 $subfield_value = MungeMarcPrice( $subfield_value );
1469 return $subfield_value if ($subfield_value);
1470 }
1471 }
1472 return 0; # no price found
1473}
1474
1475=head2 MungeMarcPrice
1476
- -
1480sub MungeMarcPrice {
1481 my ( $price ) = @_;
1482
1483 return unless ( $price =~ m/\d/ ); ## No digits means no price.
1484
1485 ## Look for the currency symbol of the active currency, if it's there,
1486 ## start the price string right after the symbol. This allows us to prefer
1487 ## this native currency price over other currency prices, if possible.
1488 my $active_currency = C4::Context->dbh->selectrow_hashref( 'SELECT * FROM currency WHERE active = 1', {} );
1489 my $symbol = quotemeta( $active_currency->{'symbol'} );
1490 if ( $price =~ m/$symbol/ ) {
1491 my @parts = split(/$symbol/, $price );
1492 $price = $parts[1];
1493 }
1494
1495 ## Grab the first number in the string ( can use commas or periods for thousands separator and/or decimal separator )
1496 ( $price ) = $price =~ m/([\d\,\.]+[[\,\.]\d\d]?)/;
1497
1498 ## Split price into array on periods and commas
1499 my @parts = split(/[\,\.]/, $price);
1500
1501 ## If the last grouping of digits is more than 2 characters, assume there is no decimal value and put it back.
1502 my $decimal = pop( @parts );
1503 if ( length( $decimal ) > 2 ) {
1504 push( @parts, $decimal );
1505 $decimal = '';
1506 }
1507
1508 $price = join('', @parts );
1509
1510 if ( $decimal ) {
1511 $price .= ".$decimal";
1512 }
1513
1514 return $price;
1515}
1516
1517
1518=head2 GetMarcQuantity
1519
- -
1525sub GetMarcQuantity {
1526 my ( $record, $marcflavour ) = @_;
1527 my @listtags;
1528 my $subfield;
1529
1530 if ( $marcflavour eq "MARC21" ) {
1531 return 0
1532 } elsif ( $marcflavour eq "UNIMARC" ) {
1533 @listtags = ('969');
1534 $subfield="a";
1535 } else {
1536 return;
1537 }
1538
1539 for my $field ( $record->field(@listtags) ) {
1540 for my $subfield_value ($field->subfield($subfield)){
1541 #check value
1542 if ($subfield_value) {
1543 # in France, the cents separator is the , but sometimes, ppl use a .
1544 # in this case, the price will be x100 when unformatted ! Replace the . by a , to get a proper price calculation
1545 $subfield_value =~ s/\./,/ if C4::Context->preference("CurrencyFormat") eq "FR";
1546 return $subfield_value;
1547 }
1548 }
1549 }
1550 return 0; # no price found
1551}
1552
1553
1554=head2 GetAuthorisedValueDesc
1555
- -
1571
# spent 790ms (18.0+772) within C4::Biblio::GetAuthorisedValueDesc which was called 295 times, avg 2.68ms/call: # 295 times (18.0ms+772ms) by C4::XSLT::transformMARCXML4XSLT at line 92 of /usr/share/koha/lib/C4/XSLT.pm, avg 2.68ms/call
sub GetAuthorisedValueDesc {
1572295592µs my ( $tag, $subfield, $value, $framework, $tagslib, $category, $opac ) = @_;
15732951.76ms295289ms my $dbh = C4::Context->dbh;
# spent 289ms making 295 calls to C4::Context::dbh, avg 980µs/call
1574
1575295511µs if ( !$category ) {
1576
15772951.71ms return $value unless defined $tagslib->{$tag}->{$subfield}->{'authorised_value'};
1578
1579 #---- branch
15802951.74ms256139ms if ( $tagslib->{$tag}->{$subfield}->{'authorised_value'} eq "branches" ) {
# spent 138ms making 64 calls to C4::Branch::GetBranchName, avg 2.16ms/call # spent 693µs making 128 calls to DBI::common::DESTROY, avg 5µs/call # spent 239µs making 64 calls to DBD::_mem::common::DESTROY, avg 4µs/call
1581 return C4::Branch::GetBranchName($value);
1582 }
1583
1584 #---- itemtypes
15852311.24ms228139ms if ( $tagslib->{$tag}->{$subfield}->{'authorised_value'} eq "itemtypes" ) {
# spent 137ms making 57 calls to C4::Koha::getitemtypeinfo, avg 2.41ms/call # spent 1.18ms making 114 calls to DBI::common::DESTROY, avg 10µs/call # spent 305µs making 57 calls to DBD::_mem::common::DESTROY, avg 5µs/call
1586 return getitemtypeinfo($value)->{description};
1587 }
1588
1589 #---- "true" authorized value
1590174282µs $category = $tagslib->{$tag}->{$subfield}->{'authorised_value'};
1591 }
1592
1593174177µs if ( $category ne "" ) {
15941743.57ms34832.4ms my $sth = $dbh->prepare( "SELECT lib, lib_opac FROM authorised_values WHERE category = ? AND authorised_value = ?" );
# spent 17.5ms making 174 calls to DBI::db::prepare, avg 101µs/call # spent 14.9ms making 174 calls to DBD::mysql::db::prepare, avg 85µs/call
1595174180ms174178ms $sth->execute( $category, $value );
# spent 178ms making 174 calls to DBI::st::execute, avg 1.02ms/call
159617411.2ms52214.2ms my $data = $sth->fetchrow_hashref;
# spent 9.98ms making 174 calls to DBI::st::fetchrow_hashref, avg 57µs/call # spent 2.64ms making 174 calls to DBI::common::FETCH, avg 15µs/call # spent 1.59ms making 174 calls to DBI::st::fetch, avg 9µs/call
15971747.54ms return ( $opac && $data->{'lib_opac'} ) ? $data->{'lib_opac'} : $data->{'lib'};
1598 } else {
1599 return $value; # if nothing is found return the original value
1600 }
1601}
1602
1603=head2 GetMarcControlnumber
1604
- -
1611sub GetMarcControlnumber {
1612 my ( $record, $marcflavour ) = @_;
1613 my $controlnumber = "";
1614 # Control number or Record identifier are the same field in MARC21, UNIMARC and NORMARC
1615 # Keep $marcflavour for possible later use
1616 if ($marcflavour eq "MARC21" || $marcflavour eq "UNIMARC" || $marcflavour eq "NORMARC") {
1617 my $controlnumberField = $record->field('001');
1618 if ($controlnumberField) {
1619 $controlnumber = $controlnumberField->data();
1620 }
1621 }
1622 return $controlnumber;
1623}
1624
1625=head2 GetMarcISBN
1626
- -
1634sub GetMarcISBN {
1635 my ( $record, $marcflavour ) = @_;
1636 my $scope;
1637 if ( $marcflavour eq "UNIMARC" ) {
1638 $scope = '010';
1639 } else { # assume marc21 if not unimarc
1640 $scope = '020';
1641 }
1642 my @marcisbns;
1643 my $isbn = "";
1644 my $tag = "";
1645 my $marcisbn;
1646 foreach my $field ( $record->field($scope) ) {
1647 my $value = $field->as_string();
1648 if ( $isbn ne "" ) {
1649 $marcisbn = { marcisbn => $isbn, };
1650 push @marcisbns, $marcisbn;
1651 $isbn = $value;
1652 }
1653 if ( $isbn ne $value ) {
1654 $isbn = $isbn . " " . $value;
1655 }
1656 }
1657
1658 if ($isbn) {
1659 $marcisbn = { marcisbn => $isbn };
1660 push @marcisbns, $marcisbn; #load last tag into array
1661 }
1662 return \@marcisbns;
1663} # end GetMarcISBN
1664
1665
1666=head2 GetMarcISSN
1667
- -
1675sub GetMarcISSN {
1676 my ( $record, $marcflavour ) = @_;
1677 my $scope;
1678 if ( $marcflavour eq "UNIMARC" ) {
1679 $scope = '011';
1680 }
1681 else { # assume MARC21 or NORMARC
1682 $scope = '022';
1683 }
1684 my @marcissns;
1685 foreach my $field ( $record->field($scope) ) {
1686 push @marcissns, $field->subfield( 'a' );
1687 }
1688 return \@marcissns;
1689} # end GetMarcISSN
1690
1691=head2 GetMarcNotes
1692
- -
1700sub GetMarcNotes {
1701 my ( $record, $marcflavour ) = @_;
1702 my $scope;
1703 if ( $marcflavour eq "UNIMARC" ) {
1704 $scope = '3..';
1705 } else { # assume marc21 if not unimarc
1706 $scope = '5..';
1707 }
1708 my @marcnotes;
1709 my $note = "";
1710 my $tag = "";
1711 my $marcnote;
1712 my %blacklist = map { $_ => 1 } split(/,/,C4::Context->preference('NotesBlacklist'));
1713 foreach my $field ( $record->field($scope) ) {
1714 my $tag = $field->tag();
1715 if (!$blacklist{$tag}) {
1716 my $value = $field->as_string();
1717 if ( $note ne "" ) {
1718 $marcnote = { marcnote => $note, };
1719 push @marcnotes, $marcnote;
1720 $note = $value;
1721 }
1722 if ( $note ne $value ) {
1723 $note = $note . " " . $value;
1724 }
1725 }
1726 }
1727
1728 if ($note) {
1729 $marcnote = { marcnote => $note };
1730 push @marcnotes, $marcnote; #load last tag into array
1731 }
1732 return \@marcnotes;
1733} # end GetMarcNotes
1734
1735=head2 GetMarcSubjects
1736
- -
1744sub GetMarcSubjects {
1745 my ( $record, $marcflavour ) = @_;
1746 my ( $mintag, $maxtag, $fields_filter );
1747 if ( $marcflavour eq "UNIMARC" ) {
1748 $mintag = "600";
1749 $maxtag = "611";
1750 $fields_filter = '6..';
1751 } else { # marc21/normarc
1752 $mintag = "600";
1753 $maxtag = "699";
1754 $fields_filter = '6..';
1755 }
1756
1757 my @marcsubjects;
1758
1759 my $subject_limit = C4::Context->preference("TraceCompleteSubfields") ? 'su,complete-subfield' : 'su';
1760 my $authoritysep = C4::Context->preference('authoritysep');
1761
1762 foreach my $field ( $record->field($fields_filter) ) {
1763 next unless ($field->tag() >= $mintag && $field->tag() <= $maxtag);
1764 my @subfields_loop;
1765 my @subfields = $field->subfields();
1766 my @link_loop;
1767
1768 # if there is an authority link, build the links with an= subfield9
1769 my $subfield9 = $field->subfield('9');
1770 my $authoritylink;
1771 if ($subfield9) {
1772 my $linkvalue = $subfield9;
1773 $linkvalue =~ s/(\(|\))//g;
1774 @link_loop = ( { limit => 'an', 'link' => $linkvalue } );
1775 $authoritylink = $linkvalue
1776 }
1777
1778 # other subfields
1779 for my $subject_subfield (@subfields) {
1780 next if ( $subject_subfield->[0] eq '9' );
1781
1782 # don't load unimarc subfields 3,4,5
1783 next if ( ( $marcflavour eq "UNIMARC" ) and ( $subject_subfield->[0] =~ /2|3|4|5/ ) );
1784 # don't load MARC21 subfields 2 (FIXME: any more subfields??)
1785 next if ( ( $marcflavour eq "MARC21" ) and ( $subject_subfield->[0] =~ /2/ ) );
1786
1787 my $code = $subject_subfield->[0];
1788 my $value = $subject_subfield->[1];
1789 my $linkvalue = $value;
1790 $linkvalue =~ s/(\(|\))//g;
1791 # if no authority link, build a search query
1792 unless ($subfield9) {
1793 push @link_loop, {
1794 limit => $subject_limit,
1795 'link' => $linkvalue,
1796 operator => (scalar @link_loop) ? ' and ' : undef
1797 };
1798 }
1799 my @this_link_loop = @link_loop;
1800 # do not display $0
1801 unless ( $code eq '0' ) {
1802 push @subfields_loop, {
1803 code => $code,
1804 value => $value,
1805 link_loop => \@this_link_loop,
1806 separator => (scalar @subfields_loop) ? $authoritysep : ''
1807 };
1808 }
1809 }
1810
1811 push @marcsubjects, {
1812 MARCSUBJECT_SUBFIELDS_LOOP => \@subfields_loop,
1813 authoritylink => $authoritylink,
1814 };
1815
1816 }
1817 return \@marcsubjects;
1818} #end getMARCsubjects
1819
1820=head2 GetMarcAuthors
1821
- -
1829sub GetMarcAuthors {
1830 my ( $record, $marcflavour ) = @_;
1831 my ( $mintag, $maxtag, $fields_filter );
1832
1833 # tagslib useful for UNIMARC author reponsabilities
1834 my $tagslib =
1835 &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.
1836 if ( $marcflavour eq "UNIMARC" ) {
1837 $mintag = "700";
1838 $maxtag = "712";
1839 $fields_filter = '7..';
1840 } else { # marc21/normarc
1841 $mintag = "700";
1842 $maxtag = "720";
1843 $fields_filter = '7..';
1844 }
1845
1846 my @marcauthors;
1847 my $authoritysep = C4::Context->preference('authoritysep');
1848
1849 foreach my $field ( $record->field($fields_filter) ) {
1850 next unless $field->tag() >= $mintag && $field->tag() <= $maxtag;
1851 my @subfields_loop;
1852 my @link_loop;
1853 my @subfields = $field->subfields();
1854 my $count_auth = 0;
1855
1856 # if there is an authority link, build the link with Koha-Auth-Number: subfield9
1857 my $subfield9 = $field->subfield('9');
1858 if ($subfield9) {
1859 my $linkvalue = $subfield9;
1860 $linkvalue =~ s/(\(|\))//g;
1861 @link_loop = ( { 'limit' => 'an', 'link' => $linkvalue } );
1862 }
1863
1864 # other subfields
1865 for my $authors_subfield (@subfields) {
1866 next if ( $authors_subfield->[0] eq '9' );
1867
1868 # don't load unimarc subfields 3, 5
1869 next if ( $marcflavour eq 'UNIMARC' and ( $authors_subfield->[0] =~ /3|5/ ) );
1870
1871 my $code = $authors_subfield->[0];
1872 my $value = $authors_subfield->[1];
1873 my $linkvalue = $value;
1874 $linkvalue =~ s/(\(|\))//g;
1875 # UNIMARC author responsibility
1876 if ( $marcflavour eq 'UNIMARC' and $code eq '4' ) {
1877 $value = GetAuthorisedValueDesc( $field->tag(), $code, $value, '', $tagslib );
1878 $linkvalue = "($value)";
1879 }
1880 # if no authority link, build a search query
1881 unless ($subfield9) {
1882 push @link_loop, {
1883 limit => 'au',
1884 'link' => $linkvalue,
1885 operator => (scalar @link_loop) ? ' and ' : undef
1886 };
1887 }
1888 my @this_link_loop = @link_loop;
1889 # do not display $0
1890 unless ( $code eq '0') {
1891 push @subfields_loop, {
1892 tag => $field->tag(),
1893 code => $code,
1894 value => $value,
1895 link_loop => \@this_link_loop,
1896 separator => (scalar @subfields_loop) ? $authoritysep : ''
1897 };
1898 }
1899 }
1900 push @marcauthors, {
1901 MARCAUTHOR_SUBFIELDS_LOOP => \@subfields_loop,
1902 authoritylink => $subfield9,
1903 };
1904 }
1905 return \@marcauthors;
1906}
1907
1908=head2 GetMarcUrls
1909
- -
1917sub GetMarcUrls {
1918 my ( $record, $marcflavour, $issn ) = @_;
1919
1920 my @marcurls;
1921 for my $field ( $record->field('856') ) {
1922 my @notes;
1923 for my $note ( $field->subfield('z') ) {
1924 push @notes, { note => $note };
1925 }
1926 my @urls = $field->subfield('u');
1927 foreach my $url (@urls) {
1928 $url .= "?sid=&ISSN=$issn"
1929 if $issn && ($url =~ m/\bserialssolutions\b/o) && ($url !~ m/\bISSN=/o);
1930 my $marcurl;
1931 if ( $marcflavour eq 'MARC21' ) {
1932 my $s3 = $field->subfield('3');
1933 my $link = $field->subfield('y');
1934 unless ( $url =~ /^\w+:/ ) {
1935 if ( $field->indicator(1) eq '7' ) {
1936 $url = $field->subfield('2') . "://" . $url;
1937 } elsif ( $field->indicator(1) eq '1' ) {
1938 $url = 'ftp://' . $url;
1939 } else {
1940
1941 # properly, this should be if ind1=4,
1942 # however we will assume http protocol since we're building a link.
1943 $url = 'http://' . $url;
1944 }
1945 }
1946
1947 # TODO handle ind 2 (relationship)
1948 $marcurl = {
1949 MARCURL => $url,
1950 notes => \@notes,
1951 };
1952 $marcurl->{'linktext'} = $link || $s3 || C4::Context->preference('URLLinkText') || $url;
1953 $marcurl->{'part'} = $s3 if ($link);
1954 $marcurl->{'toc'} = 1 if ( defined($s3) && $s3 =~ /^[Tt]able/ );
1955 } else {
1956 $marcurl->{'linktext'} = $field->subfield('2') || C4::Context->preference('URLLinkText') || $url;
1957 $marcurl->{'MARCURL'} = $url;
1958 }
1959 push @marcurls, $marcurl;
1960 }
1961 }
1962 return \@marcurls;
1963}
1964
1965=head2 GetMarcSeries
1966
- -
1974sub GetMarcSeries {
1975 my ( $record, $marcflavour ) = @_;
1976 my ( $mintag, $maxtag, $fields_filter );
1977 if ( $marcflavour eq "UNIMARC" ) {
1978 $mintag = "600";
1979 $maxtag = "619";
1980 $fields_filter = '6..';
1981 } else { # marc21/normarc
1982 $mintag = "440";
1983 $maxtag = "490";
1984 $fields_filter = '4..';
1985 }
1986
1987 my @marcseries;
1988 my $authoritysep = C4::Context->preference('authoritysep');
1989
1990 foreach my $field ( $record->field('830'), $record->field('440'), $record->field('490') ) {
1991 my @subfields_loop;
1992 my @subfields = $field->subfields();
1993 my @link_loop;
1994
1995 for my $series_subfield (@subfields) {
1996
1997 # ignore $9, used for authority link
1998 next if ( $series_subfield->[0] eq '9' );
1999
2000 my $volume_number;
2001 my $code = $series_subfield->[0];
2002 my $value = $series_subfield->[1];
2003 my $linkvalue = $value;
2004 $linkvalue =~ s/(\(|\))//g;
2005
2006 # see if this is an instance of a volume
2007 if ( $code eq 'v' ) {
2008 $volume_number = 1;
2009 }
2010
2011 push @link_loop, {
2012 'link' => $linkvalue,
2013 operator => (scalar @link_loop) ? ' and ' : undef
2014 };
2015
2016 if ($volume_number) {
2017 push @subfields_loop, { volumenum => $value };
2018 } else {
2019 push @subfields_loop, {
2020 code => $code,
2021 value => $value,
2022 link_loop => \@link_loop,
2023 separator => (scalar @subfields_loop) ? $authoritysep : '',
2024 volumenum => $volume_number,
2025 }
2026 }
2027 }
2028 push @marcseries, { MARCSERIES_SUBFIELDS_LOOP => \@subfields_loop };
2029
2030 }
2031 return \@marcseries;
2032} #end getMARCseriess
2033
2034=head2 GetMarcHosts
2035
- -
2042sub GetMarcHosts {
2043 my ( $record, $marcflavour ) = @_;
2044 my ( $tag,$title_subf,$bibnumber_subf,$itemnumber_subf);
2045 $marcflavour ||="MARC21";
2046 if ( $marcflavour eq "MARC21" || $marcflavour eq "NORMARC" ) {
2047 $tag = "773";
2048 $title_subf = "t";
2049 $bibnumber_subf ="0";
2050 $itemnumber_subf='9';
2051 }
2052 elsif ($marcflavour eq "UNIMARC") {
2053 $tag = "461";
2054 $title_subf = "t";
2055 $bibnumber_subf ="0";
2056 $itemnumber_subf='9';
2057 };
2058
2059 my @marchosts;
2060
2061 foreach my $field ( $record->field($tag)) {
2062
2063 my @fields_loop;
2064
2065 my $hostbiblionumber = $field->subfield("$bibnumber_subf");
2066 my $hosttitle = $field->subfield($title_subf);
2067 my $hostitemnumber=$field->subfield($itemnumber_subf);
2068 push @fields_loop, { hostbiblionumber => $hostbiblionumber, hosttitle => $hosttitle, hostitemnumber => $hostitemnumber};
2069 push @marchosts, { MARCHOSTS_FIELDS_LOOP => \@fields_loop };
2070
2071 }
2072 my $marchostsarray = \@marchosts;
2073 return $marchostsarray;
2074}
2075
2076=head2 GetFrameworkCode
2077
- -
2082
# spent 232ms (7.64+224) within C4::Biblio::GetFrameworkCode which was called 100 times, avg 2.32ms/call: # 25 times (2.05ms+65.8ms) by C4::Search::searchResults at line 1702 of /usr/share/koha/lib/C4/Search.pm, avg 2.72ms/call # 25 times (1.89ms+56.0ms) by C4::XSLT::transformMARCXML4XSLT at line 77 of /usr/share/koha/lib/C4/XSLT.pm, avg 2.31ms/call # 25 times (1.91ms+53.8ms) by C4::XSLT::buildKohaItemsNamespace at line 254 of /usr/share/koha/lib/C4/XSLT.pm, avg 2.23ms/call # 25 times (1.79ms+48.9ms) by C4::XSLT::buildKohaItemsNamespace at line 255 of /usr/share/koha/lib/C4/XSLT.pm, avg 2.03ms/call
sub GetFrameworkCode {
2083100172µs my ($biblionumber) = @_;
2084100761µs100101ms my $dbh = C4::Context->dbh;
# spent 101ms making 100 calls to C4::Context::dbh, avg 1.01ms/call
20851002.31ms20020.8ms my $sth = $dbh->prepare("SELECT frameworkcode FROM biblio WHERE biblionumber=?");
# spent 11.3ms making 100 calls to DBI::db::prepare, avg 113µs/call # spent 9.56ms making 100 calls to DBD::mysql::db::prepare, avg 96µs/call
2086100110ms100109ms $sth->execute($biblionumber);
# spent 109ms making 100 calls to DBI::st::execute, avg 1.09ms/call
20871002.87ms1001.95ms my ($frameworkcode) = $sth->fetchrow;
# spent 1.95ms making 100 calls to DBI::st::fetchrow, avg 19µs/call
20881005.28ms return $frameworkcode;
2089}
2090
2091=head2 TransformKohaToMarc
2092
- -
2104sub TransformKohaToMarc {
2105 my $hash = shift;
2106 my $record = MARC::Record->new();
2107 SetMarcUnicodeFlag( $record, C4::Context->preference("marcflavour") );
2108 my $db_to_marc = C4::Context->marcfromkohafield;
2109 while ( my ($name, $value) = each %$hash ) {
2110 next unless my $dtm = $db_to_marc->{''}->{$name};
2111 next unless ( scalar( @$dtm ) );
2112 my ($tag, $letter) = @$dtm;
2113 foreach my $value ( split(/\s?\|\s?/, $value, -1) ) {
2114 if ( my $field = $record->field($tag) ) {
2115 $field->add_subfields( $letter => $value );
2116 }
2117 else {
2118 $record->insert_fields_ordered( MARC::Field->new(
2119 $tag, " ", " ", $letter => $value ) );
2120 }
2121 }
2122
2123 }
2124 return $record;
2125}
2126
2127=head2 PrepHostMarcField
2128
- -
2135sub PrepHostMarcField {
2136 my ($hostbiblionumber,$hostitemnumber, $marcflavour) = @_;
2137 $marcflavour ||="MARC21";
2138
2139 require C4::Items;
2140 my $hostrecord = GetMarcBiblio($hostbiblionumber);
2141 my $item = C4::Items::GetItem($hostitemnumber);
2142
2143 my $hostmarcfield;
2144 if ( $marcflavour eq "MARC21" || $marcflavour eq "NORMARC" ) {
2145
2146 #main entry
2147 my $mainentry;
2148 if ($hostrecord->subfield('100','a')){
2149 $mainentry = $hostrecord->subfield('100','a');
2150 } elsif ($hostrecord->subfield('110','a')){
2151 $mainentry = $hostrecord->subfield('110','a');
2152 } else {
2153 $mainentry = $hostrecord->subfield('111','a');
2154 }
2155
2156 # qualification info
2157 my $qualinfo;
2158 if (my $field260 = $hostrecord->field('260')){
2159 $qualinfo = $field260->as_string( 'abc' );
2160 }
2161
2162
2163 #other fields
2164 my $ed = $hostrecord->subfield('250','a');
2165 my $barcode = $item->{'barcode'};
2166 my $title = $hostrecord->subfield('245','a');
2167
2168 # record control number, 001 with 003 and prefix
2169 my $recctrlno;
2170 if ($hostrecord->field('001')){
2171 $recctrlno = $hostrecord->field('001')->data();
2172 if ($hostrecord->field('003')){
2173 $recctrlno = '('.$hostrecord->field('003')->data().')'.$recctrlno;
2174 }
2175 }
2176
2177 # issn/isbn
2178 my $issn = $hostrecord->subfield('022','a');
2179 my $isbn = $hostrecord->subfield('020','a');
2180
2181
2182 $hostmarcfield = MARC::Field->new(
2183 773, '0', '',
2184 '0' => $hostbiblionumber,
2185 '9' => $hostitemnumber,
2186 'a' => $mainentry,
2187 'b' => $ed,
2188 'd' => $qualinfo,
2189 'o' => $barcode,
2190 't' => $title,
2191 'w' => $recctrlno,
2192 'x' => $issn,
2193 'z' => $isbn
2194 );
2195 } elsif ($marcflavour eq "UNIMARC") {
2196 $hostmarcfield = MARC::Field->new(
2197 461, '', '',
2198 '0' => $hostbiblionumber,
2199 't' => $hostrecord->subfield('200','a'),
2200 '9' => $hostitemnumber
2201 );
2202 };
2203
2204 return $hostmarcfield;
2205}
2206
2207=head2 TransformHtmlToXml
2208
- -
2226sub TransformHtmlToXml {
2227 my ( $tags, $subfields, $values, $indicator, $ind_tag, $auth_type ) = @_;
2228 my $xml = MARC::File::XML::header('UTF-8');
2229 $xml .= "<record>\n";
2230 $auth_type = C4::Context->preference('marcflavour') unless $auth_type;
2231 MARC::File::XML->default_record_format($auth_type);
2232
2233 # in UNIMARC, field 100 contains the encoding
2234 # check that there is one, otherwise the
2235 # MARC::Record->new_from_xml will fail (and Koha will die)
2236 my $unimarc_and_100_exist = 0;
2237 $unimarc_and_100_exist = 1 if $auth_type eq 'ITEM'; # if we rebuild an item, no need of a 100 field
2238 my $prevvalue;
2239 my $prevtag = -1;
2240 my $first = 1;
2241 my $j = -1;
2242 for ( my $i = 0 ; $i < @$tags ; $i++ ) {
2243
2244 if ( C4::Context->preference('marcflavour') eq 'UNIMARC' and @$tags[$i] eq "100" and @$subfields[$i] eq "a" ) {
2245
2246 # if we have a 100 field and it's values are not correct, skip them.
2247 # if we don't have any valid 100 field, we will create a default one at the end
2248 my $enc = substr( @$values[$i], 26, 2 );
2249 if ( $enc eq '01' or $enc eq '50' or $enc eq '03' ) {
2250 $unimarc_and_100_exist = 1;
2251 } else {
2252 next;
2253 }
2254 }
2255 @$values[$i] =~ s/&/&amp;/g;
2256 @$values[$i] =~ s/</&lt;/g;
2257 @$values[$i] =~ s/>/&gt;/g;
2258 @$values[$i] =~ s/"/&quot;/g;
2259 @$values[$i] =~ s/'/&apos;/g;
2260
2261 # if ( !utf8::is_utf8( @$values[$i] ) ) {
2262 # utf8::decode( @$values[$i] );
2263 # }
2264 if ( ( @$tags[$i] ne $prevtag ) ) {
2265 $j++ unless ( @$tags[$i] eq "" );
2266 my $indicator1 = eval { substr( @$indicator[$j], 0, 1 ) };
2267 my $indicator2 = eval { substr( @$indicator[$j], 1, 1 ) };
2268 my $ind1 = _default_ind_to_space($indicator1);
2269 my $ind2;
2270 if ( @$indicator[$j] ) {
2271 $ind2 = _default_ind_to_space($indicator2);
2272 } else {
2273 warn "Indicator in @$tags[$i] is empty";
2274 $ind2 = " ";
2275 }
2276 if ( !$first ) {
2277 $xml .= "</datafield>\n";
2278 if ( ( @$tags[$i] && @$tags[$i] > 10 )
2279 && ( @$values[$i] ne "" ) ) {
2280 $xml .= "<datafield tag=\"@$tags[$i]\" ind1=\"$ind1\" ind2=\"$ind2\">\n";
2281 $xml .= "<subfield code=\"@$subfields[$i]\">@$values[$i]</subfield>\n";
2282 $first = 0;
2283 } else {
2284 $first = 1;
2285 }
2286 } else {
2287 if ( @$values[$i] ne "" ) {
2288
2289 # leader
2290 if ( @$tags[$i] eq "000" ) {
2291 $xml .= "<leader>@$values[$i]</leader>\n";
2292 $first = 1;
2293
2294 # rest of the fixed fields
2295 } elsif ( @$tags[$i] < 10 ) {
2296 $xml .= "<controlfield tag=\"@$tags[$i]\">@$values[$i]</controlfield>\n";
2297 $first = 1;
2298 } else {
2299 $xml .= "<datafield tag=\"@$tags[$i]\" ind1=\"$ind1\" ind2=\"$ind2\">\n";
2300 $xml .= "<subfield code=\"@$subfields[$i]\">@$values[$i]</subfield>\n";
2301 $first = 0;
2302 }
2303 }
2304 }
2305 } else { # @$tags[$i] eq $prevtag
2306 my $indicator1 = eval { substr( @$indicator[$j], 0, 1 ) };
2307 my $indicator2 = eval { substr( @$indicator[$j], 1, 1 ) };
2308 my $ind1 = _default_ind_to_space($indicator1);
2309 my $ind2;
2310 if ( @$indicator[$j] ) {
2311 $ind2 = _default_ind_to_space($indicator2);
2312 } else {
2313 warn "Indicator in @$tags[$i] is empty";
2314 $ind2 = " ";
2315 }
2316 if ( @$values[$i] eq "" ) {
2317 } else {
2318 if ($first) {
2319 $xml .= "<datafield tag=\"@$tags[$i]\" ind1=\"$ind1\" ind2=\"$ind2\">\n";
2320 $first = 0;
2321 }
2322 $xml .= "<subfield code=\"@$subfields[$i]\">@$values[$i]</subfield>\n";
2323 }
2324 }
2325 $prevtag = @$tags[$i];
2326 }
2327 $xml .= "</datafield>\n" if $xml =~ m/<datafield/;
2328 if ( C4::Context->preference('marcflavour') eq 'UNIMARC' and !$unimarc_and_100_exist ) {
2329
2330 # warn "SETTING 100 for $auth_type";
2331 my $string = strftime( "%Y%m%d", localtime(time) );
2332
2333 # set 50 to position 26 is biblios, 13 if authorities
2334 my $pos = 26;
2335 $pos = 13 if $auth_type eq 'UNIMARCAUTH';
2336 $string = sprintf( "%-*s", 35, $string );
2337 substr( $string, $pos, 6, "50" );
2338 $xml .= "<datafield tag=\"100\" ind1=\"\" ind2=\"\">\n";
2339 $xml .= "<subfield code=\"a\">$string</subfield>\n";
2340 $xml .= "</datafield>\n";
2341 }
2342 $xml .= "</record>\n";
2343 $xml .= MARC::File::XML::footer();
2344 return $xml;
2345}
2346
2347=head2 _default_ind_to_space
2348
- -
2354sub _default_ind_to_space {
2355 my $s = shift;
2356 if ( !defined $s || $s eq q{} ) {
2357 return ' ';
2358 }
2359 return $s;
2360}
2361
2362=head2 TransformHtmlToMarc
2363
- -
2386sub TransformHtmlToMarc {
2387 my $cgi = shift;
2388
2389 my @params = $cgi->param();
2390
2391 # explicitly turn on the UTF-8 flag for all
2392 # 'tag_' parameters to avoid incorrect character
2393 # conversion later on
2394 my $cgi_params = $cgi->Vars;
2395 foreach my $param_name ( keys %$cgi_params ) {
2396 if ( $param_name =~ /^tag_/ ) {
2397 my $param_value = $cgi_params->{$param_name};
2398 if ( utf8::decode($param_value) ) {
2399 $cgi_params->{$param_name} = $param_value;
2400 }
2401
2402 # FIXME - need to do something if string is not valid UTF-8
2403 }
2404 }
2405
2406 # creating a new record
2407 my $record = MARC::Record->new();
2408 my $i = 0;
2409 my @fields;
2410#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!
2411 while ( $params[$i] ) { # browse all CGI params
2412 my $param = $params[$i];
2413 my $newfield = 0;
2414
2415 # if we are on biblionumber, store it in the MARC::Record (it may not be in the edited fields)
2416 if ( $param eq 'biblionumber' ) {
2417 my ( $biblionumbertagfield, $biblionumbertagsubfield ) = &GetMarcFromKohaField( "biblio.biblionumber", '' );
2418 if ( $biblionumbertagfield < 10 ) {
2419 $newfield = MARC::Field->new( $biblionumbertagfield, $cgi->param($param), );
2420 } else {
2421 $newfield = MARC::Field->new( $biblionumbertagfield, '', '', "$biblionumbertagsubfield" => $cgi->param($param), );
2422 }
2423 push @fields, $newfield if ($newfield);
2424 } elsif ( $param =~ /^tag_(\d*)_indicator1_/ ) { # new field start when having 'input name="..._indicator1_..."
2425 my $tag = $1;
2426
2427 my $ind1 = _default_ind_to_space( substr( $cgi->param($param), 0, 1 ) );
2428 my $ind2 = _default_ind_to_space( substr( $cgi->param( $params[ $i + 1 ] ), 0, 1 ) );
2429 $newfield = 0;
2430 my $j = $i + 2;
2431
2432 if ( $tag < 10 ) { # no code for theses fields
2433 # in MARC editor, 000 contains the leader.
2434 if ( $tag eq '000' ) {
2435 # Force a fake leader even if not provided to avoid crashing
2436 # during decoding MARC record containing UTF-8 characters
2437 $record->leader(
2438 length( $cgi->param($params[$j+1]) ) == 24
2439 ? $cgi->param( $params[ $j + 1 ] )
2440 : ' nam a22 4500'
2441 )
2442 ;
2443 # between 001 and 009 (included)
2444 } elsif ( $cgi->param( $params[ $j + 1 ] ) ne '' ) {
2445 $newfield = MARC::Field->new( $tag, $cgi->param( $params[ $j + 1 ] ), );
2446 }
2447
2448 # > 009, deal with subfields
2449 } else {
2450 # browse subfields for this tag (reason for _code_ match)
2451 while(defined $params[$j] && $params[$j] =~ /_code_/) {
2452 last unless defined $params[$j+1];
2453 #if next param ne subfield, then it was probably empty
2454 #try next param by incrementing j
2455 if($params[$j+1]!~/_subfield_/) {$j++; next; }
2456 my $fval= $cgi->param($params[$j+1]);
2457 #check if subfield value not empty and field exists
2458 if($fval ne '' && $newfield) {
2459 $newfield->add_subfields( $cgi->param($params[$j]) => $fval);
2460 }
2461 elsif($fval ne '') {
2462 $newfield = MARC::Field->new( $tag, $ind1, $ind2, $cgi->param($params[$j]) => $fval );
2463 }
2464 $j += 2;
2465 } #end-of-while
2466 $i= $j-1; #update i for outer loop accordingly
2467 }
2468 push @fields, $newfield if ($newfield);
2469 }
2470 $i++;
2471 }
2472
2473 $record->append_fields(@fields);
2474 return $record;
2475}
2476
2477# cache inverted MARC field map
24781400nsour $inverted_field_map;
2479
2480=head2 TransformMarcToKoha
2481
- -
2489
# spent 47.9ms (31.8+16.1) within C4::Biblio::TransformMarcToKoha which was called 25 times, avg 1.91ms/call: # 25 times (31.8ms+16.1ms) by C4::Search::searchResults at line 1707 of /usr/share/koha/lib/C4/Search.pm, avg 1.91ms/call
sub TransformMarcToKoha {
24902563µs my ( $dbh, $record, $frameworkcode, $limit_table ) = @_;
2491
24922510µs my $result;
24932534µs $limit_table = $limit_table || 0;
24942520µs $frameworkcode = '' unless defined $frameworkcode;
2495
24962521µs unless ( defined $inverted_field_map ) {
249717µs14.94ms $inverted_field_map = _get_inverted_marc_field_map();
# spent 4.94ms making 1 call to C4::Biblio::_get_inverted_marc_field_map
2498 }
2499
25002549µs my %tables = ();
25012587µs if ( defined $limit_table && $limit_table eq 'items' ) {
2502 $tables{'items'} = 1;
2503 } else {
25042572µs $tables{'items'} = 1;
25052544µs $tables{'biblio'} = 1;
25062541µs $tables{'biblioitems'} = 1;
2507 }
2508
2509 # traverse through record
251025341µs25244µs MARCFIELD: foreach my $field ( $record->fields() ) {
# spent 244µs making 25 calls to MARC::Record::fields, avg 10µs/call
251154412.4ms5442.08ms my $tag = $field->tag();
# spent 2.08ms making 544 calls to MARC::Field::tag, avg 4µs/call
2512544791µs next MARCFIELD unless exists $inverted_field_map->{$frameworkcode}->{$tag};
25132021.07ms202631µs if ( $field->is_control_field() ) {
# spent 631µs making 202 calls to MARC::Field::is_control_field, avg 3µs/call
2514 my $kohafields = $inverted_field_map->{$frameworkcode}->{$tag}->{list};
2515 ENTRY: foreach my $entry ( @{$kohafields} ) {
2516 my ( $subfield, $table, $column ) = @{$entry};
2517 next ENTRY unless exists $tables{$table};
2518 my $key = _disambiguate( $table, $column );
2519 if ( $result->{$key} ) {
2520 unless ( ( $key eq "biblionumber" or $key eq "biblioitemnumber" ) and ( $field->data() eq "" ) ) {
2521 $result->{$key} .= " | " . $field->data();
2522 }
2523 } else {
2524 $result->{$key} = $field->data();
2525 }
2526 }
2527 } else {
2528
2529 # deal with subfields
2530202690µs2024.70ms MARCSUBFIELD: foreach my $sf ( $field->subfields() ) {
# spent 4.70ms making 202 calls to MARC::Field::subfields, avg 23µs/call
2531871575µs my $code = $sf->[0];
25328711.52ms next MARCSUBFIELD unless exists $inverted_field_map->{$frameworkcode}->{$tag}->{sfs}->{$code};
2533843468µs my $value = $sf->[1];
25348432.02ms SFENTRY: foreach my $entry ( @{ $inverted_field_map->{$frameworkcode}->{$tag}->{sfs}->{$code} } ) {
2535843918µs my ( $table, $column ) = @{$entry};
2536843409µs next SFENTRY unless exists $tables{$table};
25378432.12ms8433.21ms my $key = _disambiguate( $table, $column );
# spent 3.21ms making 843 calls to C4::Biblio::_disambiguate, avg 4µs/call
25388433.86ms if ( $result->{$key} ) {
2539 unless ( ( $key eq "biblionumber" or $key eq "biblioitemnumber" ) and ( $value eq "" ) ) {
2540 $result->{$key} .= " | " . $value;
2541 }
2542 } else {
25437371.33ms $result->{$key} = $value;
2544 }
2545 }
2546 }
2547 }
2548 }
2549
2550 # modify copyrightdate to keep only the 1st year found
25512547µs if ( exists $result->{'copyrightdate'} ) {
25522433µs my $temp = $result->{'copyrightdate'};
255324196µs2473µs $temp =~ m/c(\d\d\d\d)/;
# spent 73µs making 24 calls to C4::Biblio::CORE:match, avg 3µs/call
255424113µs2418µs if ( $temp =~ m/c(\d\d\d\d)/ and $1 > 0 ) { # search cYYYY first
# spent 18µs making 24 calls to C4::Biblio::CORE:match, avg 754ns/call
2555 $result->{'copyrightdate'} = $1;
2556 } else { # if no cYYYY, get the 1st date.
255723267µs23199µs $temp =~ m/(\d\d\d\d)/;
# spent 199µs making 23 calls to C4::Biblio::CORE:match, avg 9µs/call
255823164µs $result->{'copyrightdate'} = $1;
2559 }
2560 }
2561
2562 # modify publicationyear to keep only the 1st year found
25632525µs if ( exists $result->{'publicationyear'} ) {
2564 my $temp = $result->{'publicationyear'};
2565 if ( $temp =~ m/c(\d\d\d\d)/ and $1 > 0 ) { # search cYYYY first
2566 $result->{'publicationyear'} = $1;
2567 } else { # if no cYYYY, get the 1st date.
2568 $temp =~ m/(\d\d\d\d)/;
2569 $result->{'publicationyear'} = $1;
2570 }
2571 }
2572
257325195µs return $result;
2574}
2575
2576
# spent 4.94ms (4.93+12µs) within C4::Biblio::_get_inverted_marc_field_map which was called: # once (4.93ms+12µs) by C4::Biblio::TransformMarcToKoha at line 2497
sub _get_inverted_marc_field_map {
257712µs my $field_map = {};
2578110µs112µs my $relations = C4::Context->marcfromkohafield;
# spent 12µs making 1 call to C4::Context::marcfromkohafield
2579
2580111µs foreach my $frameworkcode ( keys %{$relations} ) {
25815124µs foreach my $kohafield ( keys %{ $relations->{$frameworkcode} } ) {
2582302543µs next unless @{ $relations->{$frameworkcode}->{$kohafield} }; # not all columns are mapped to MARC tag & subfield
2583302407µs my $tag = $relations->{$frameworkcode}->{$kohafield}->[0];
2584302314µs my $subfield = $relations->{$frameworkcode}->{$kohafield}->[1];
2585302784µs my ( $table, $column ) = split /[.]/, $kohafield, 2;
25863021.26ms push @{ $field_map->{$frameworkcode}->{$tag}->{list} }, [ $subfield, $table, $column ];
25873021.45ms push @{ $field_map->{$frameworkcode}->{$tag}->{sfs}->{$subfield} }, [ $table, $column ];
2588 }
2589 }
2590131µs return $field_map;
2591}
2592
2593=head2 _disambiguate
2594
- -
2622
# spent 65.8ms (2.21+63.6) within C4::Biblio::CountItemsIssued which was called 25 times, avg 2.63ms/call: # 25 times (2.21ms+63.6ms) by main::RUNTIME at line 580 of /usr/share/koha/opac/cgi-bin/opac/opac-search.pl, avg 2.63ms/call
sub CountItemsIssued {
26232529µs my ($biblionumber) = @_;
262425130µs2525.3ms my $dbh = C4::Context->dbh;
# spent 25.3ms making 25 calls to C4::Context::dbh, avg 1.01ms/call
262525419µs503.69ms my $sth = $dbh->prepare('SELECT COUNT(*) as issuedCount FROM items, issues WHERE items.itemnumber = issues.itemnumber AND items.biblionumber = ?');
# spent 2.01ms making 25 calls to DBI::db::prepare, avg 80µs/call # spent 1.69ms making 25 calls to DBD::mysql::db::prepare, avg 67µs/call
26262534.4ms2533.8ms $sth->execute($biblionumber);
# spent 33.8ms making 25 calls to DBI::st::execute, avg 1.35ms/call
2627252.26ms752.70ms my $row = $sth->fetchrow_hashref();
# spent 1.96ms making 25 calls to DBI::st::fetchrow_hashref, avg 79µs/call # spent 519µs making 25 calls to DBI::common::FETCH, avg 21µs/call # spent 220µs making 25 calls to DBI::st::fetch, avg 9µs/call
2628251.51ms return $row->{'issuedCount'};
2629}
2630
2631
# spent 3.21ms within C4::Biblio::_disambiguate which was called 843 times, avg 4µs/call: # 843 times (3.21ms+0s) by C4::Biblio::TransformMarcToKoha at line 2537, avg 4µs/call
sub _disambiguate {
2632843523µs my ( $table, $column ) = @_;
2633843770µs if ( $column eq "cn_sort" or $column eq "cn_source" ) {
2634 return $table . '.' . $column;
2635 } else {
26367832.75ms return $column;
2637 }
2638
2639}
2640
2641=head2 get_koha_field_from_marc
2642
- -
2651sub get_koha_field_from_marc {
2652 my ( $koha_table, $koha_column, $record, $frameworkcode ) = @_;
2653 my ( $tagfield, $subfield ) = GetMarcFromKohaField( $koha_table . '.' . $koha_column, $frameworkcode );
2654 my $kohafield;
2655 foreach my $field ( $record->field($tagfield) ) {
2656 if ( $field->tag() < 10 ) {
2657 if ($kohafield) {
2658 $kohafield .= " | " . $field->data();
2659 } else {
2660 $kohafield = $field->data();
2661 }
2662 } else {
2663 if ( $field->subfields ) {
2664 my @subfields = $field->subfields();
2665 foreach my $subfieldcount ( 0 .. $#subfields ) {
2666 if ( $subfields[$subfieldcount][0] eq $subfield ) {
2667 if ($kohafield) {
2668 $kohafield .= " | " . $subfields[$subfieldcount][1];
2669 } else {
2670 $kohafield = $subfields[$subfieldcount][1];
2671 }
2672 }
2673 }
2674 }
2675 }
2676 }
2677 return $kohafield;
2678}
2679
2680=head2 TransformMarcToKohaOneField
2681
- -
2686sub TransformMarcToKohaOneField {
2687
2688 # FIXME ? if a field has a repeatable subfield that is used in old-db,
2689 # only the 1st will be retrieved...
2690 my ( $kohatable, $kohafield, $record, $result, $frameworkcode ) = @_;
2691 my $res = "";
2692 my ( $tagfield, $subfield ) = GetMarcFromKohaField( $kohatable . "." . $kohafield, $frameworkcode );
2693 foreach my $field ( $record->field($tagfield) ) {
2694 if ( $field->tag() < 10 ) {
2695 if ( $result->{$kohafield} ) {
2696 $result->{$kohafield} .= " | " . $field->data();
2697 } else {
2698 $result->{$kohafield} = $field->data();
2699 }
2700 } else {
2701 if ( $field->subfields ) {
2702 my @subfields = $field->subfields();
2703 foreach my $subfieldcount ( 0 .. $#subfields ) {
2704 if ( $subfields[$subfieldcount][0] eq $subfield ) {
2705 if ( $result->{$kohafield} ) {
2706 $result->{$kohafield} .= " | " . $subfields[$subfieldcount][1];
2707 } else {
2708 $result->{$kohafield} = $subfields[$subfieldcount][1];
2709 }
2710 }
2711 }
2712 }
2713 }
2714 }
2715 return $result;
2716}
2717
2718
2719#"
2720
2721#
2722# true ModZebra commented until indexdata fixes zebraDB crashes (it seems they occur on multiple updates
2723# at the same time
2724# replaced by a zebraqueue table, that is filled with ModZebra to run.
2725# the table is emptied by misc/cronjobs/zebraqueue_start.pl script
2726# =head2 ModZebrafiles
2727#
2728# &ModZebrafiles( $dbh, $biblionumber, $record, $folder, $server );
2729#
2730# =cut
2731#
2732# sub ModZebrafiles {
2733#
2734# my ( $dbh, $biblionumber, $record, $folder, $server ) = @_;
2735#
2736# my $op;
2737# my $zebradir =
2738# C4::Context->zebraconfig($server)->{directory} . "/" . $folder . "/";
2739# unless ( opendir( DIR, "$zebradir" ) ) {
2740# warn "$zebradir not found";
2741# return;
2742# }
2743# closedir DIR;
2744# my $filename = $zebradir . $biblionumber;
2745#
2746# if ($record) {
2747# open( OUTPUT, ">", $filename . ".xml" );
2748# print OUTPUT $record;
2749# close OUTPUT;
2750# }
2751# }
2752
2753=head2 ModZebra
2754
- -
2765sub ModZebra {
2766###Accepts a $server variable thus we can use it for biblios authorities or other zebra dbs
2767 my ( $biblionumber, $op, $server ) = @_;
2768 my $dbh = C4::Context->dbh;
2769
2770 # true ModZebra commented until indexdata fixes zebraDB crashes (it seems they occur on multiple updates
2771 # at the same time
2772 # replaced by a zebraqueue table, that is filled with ModZebra to run.
2773 # the table is emptied by rebuild_zebra.pl script (using the -z switch)
2774
2775 my $check_sql = "SELECT COUNT(*) FROM zebraqueue
2776 WHERE server = ?
2777 AND biblio_auth_number = ?
2778 AND operation = ?
2779 AND done = 0";
2780 my $check_sth = $dbh->prepare_cached($check_sql);
2781 $check_sth->execute( $server, $biblionumber, $op );
2782 my ($count) = $check_sth->fetchrow_array;
2783 $check_sth->finish();
2784 if ( $count == 0 ) {
2785 my $sth = $dbh->prepare("INSERT INTO zebraqueue (biblio_auth_number,server,operation) VALUES(?,?,?)");
2786 $sth->execute( $biblionumber, $server, $op );
2787 $sth->finish;
2788 }
2789}
2790
2791
2792=head2 EmbedItemsInMarcBiblio
2793
- -
2803sub EmbedItemsInMarcBiblio {
2804 my ($marc, $biblionumber, $itemnumbers) = @_;
2805 croak "No MARC record" unless $marc;
2806
2807 $itemnumbers = [] unless defined $itemnumbers;
2808
2809 my $frameworkcode = GetFrameworkCode($biblionumber);
2810 _strip_item_fields($marc, $frameworkcode);
2811
2812 # ... and embed the current items
2813 my $dbh = C4::Context->dbh;
2814 my $sth = $dbh->prepare("SELECT itemnumber FROM items WHERE biblionumber = ?");
2815 $sth->execute($biblionumber);
2816 my @item_fields;
2817 my ( $itemtag, $itemsubfield ) = GetMarcFromKohaField( "items.itemnumber", $frameworkcode );
2818 while (my ($itemnumber) = $sth->fetchrow_array) {
2819 next if @$itemnumbers and not grep { $_ == $itemnumber } @$itemnumbers;
2820 require C4::Items;
2821 my $item_marc = C4::Items::GetMarcItem($biblionumber, $itemnumber);
2822 push @item_fields, $item_marc->field($itemtag);
2823 }
2824 $marc->append_fields(@item_fields);
2825}
2826
2827=head1 INTERNAL FUNCTIONS
2828
- -
2839
# spent 16.3ms (1.34+15.0) within C4::Biblio::_koha_marc_update_bib_ids which was called 25 times, avg 652µs/call: # 25 times (1.34ms+15.0ms) by C4::Biblio::GetMarcBiblio at line 1267, avg 652µs/call
sub _koha_marc_update_bib_ids {
28402576µs my ( $record, $frameworkcode, $biblionumber, $biblioitemnumber ) = @_;
2841
2842 # we must add bibnum and bibitemnum in MARC::Record...
2843 # we build the new field with biblionumber and biblioitemnumber
2844 # we drop the original field
2845 # we add the new builded field.
284625135µs25706µs my ( $biblio_tag, $biblio_subfield ) = GetMarcFromKohaField( "biblio.biblionumber", $frameworkcode );
# spent 706µs making 25 calls to C4::Biblio::GetMarcFromKohaField, avg 28µs/call
28472514µs die qq{No biblionumber tag for framework "$frameworkcode"} unless $biblio_tag;
284825104µs25282µs my ( $biblioitem_tag, $biblioitem_subfield ) = GetMarcFromKohaField( "biblioitems.biblioitemnumber", $frameworkcode );
# spent 282µs making 25 calls to C4::Biblio::GetMarcFromKohaField, avg 11µs/call
28492510µs die qq{No biblioitemnumber tag for framework "$frameworkcode"} unless $biblioitem_tag;
2850
285125152µs if ( $biblio_tag == $biblioitem_tag ) {
2852
2853 # biblionumber & biblioitemnumber are in the same field (can't be <10 as fields <10 have only 1 value)
285425140µs251.19ms my $new_field = MARC::Field->new(
# spent 1.19ms making 25 calls to MARC::Field::new, avg 47µs/call
2855 $biblio_tag, '', '',
2856 "$biblio_subfield" => $biblionumber,
2857 "$biblioitem_subfield" => $biblioitemnumber
2858 );
2859
2860 # drop old field and create new one...
286125175µs256.46ms my $old_field = $record->field($biblio_tag);
# spent 6.46ms making 25 calls to MARC::Record::field, avg 258µs/call
286225119µs251.01ms $record->delete_field($old_field) if $old_field;
# spent 1.01ms making 25 calls to MARC::Record::delete_field, avg 41µs/call
286325213µs255.32ms $record->insert_fields_ordered($new_field);
# spent 5.32ms making 25 calls to MARC::Record::insert_fields_ordered, avg 213µs/call
2864 } else {
2865
2866 # biblionumber & biblioitemnumber are in different fields
2867
2868 # deal with biblionumber
2869 my ( $new_field, $old_field );
2870 if ( $biblio_tag < 10 ) {
2871 $new_field = MARC::Field->new( $biblio_tag, $biblionumber );
2872 } else {
2873 $new_field = MARC::Field->new( $biblio_tag, '', '', "$biblio_subfield" => $biblionumber );
2874 }
2875
2876 # drop old field and create new one...
2877 $old_field = $record->field($biblio_tag);
2878 $record->delete_field($old_field) if $old_field;
2879 $record->insert_fields_ordered($new_field);
2880
2881 # deal with biblioitemnumber
2882 if ( $biblioitem_tag < 10 ) {
2883 $new_field = MARC::Field->new( $biblioitem_tag, $biblioitemnumber, );
2884 } else {
2885 $new_field = MARC::Field->new( $biblioitem_tag, '', '', "$biblioitem_subfield" => $biblioitemnumber, );
2886 }
2887
2888 # drop old field and create new one...
2889 $old_field = $record->field($biblioitem_tag);
2890 $record->delete_field($old_field) if $old_field;
2891 $record->insert_fields_ordered($new_field);
2892 }
2893}
2894
2895=head2 _koha_marc_update_biblioitem_cn_sort
2896
- -
2904sub _koha_marc_update_biblioitem_cn_sort {
2905 my $marc = shift;
2906 my $biblioitem = shift;
2907 my $frameworkcode = shift;
2908
2909 my ( $biblioitem_tag, $biblioitem_subfield ) = GetMarcFromKohaField( "biblioitems.cn_sort", $frameworkcode );
2910 return unless $biblioitem_tag;
2911
2912 my ($cn_sort) = GetClassSort( $biblioitem->{'biblioitems.cn_source'}, $biblioitem->{'cn_class'}, $biblioitem->{'cn_item'} );
2913
2914 if ( my $field = $marc->field($biblioitem_tag) ) {
2915 $field->delete_subfield( code => $biblioitem_subfield );
2916 if ( $cn_sort ne '' ) {
2917 $field->add_subfields( $biblioitem_subfield => $cn_sort );
2918 }
2919 } else {
2920
2921 # if we get here, no biblioitem tag is present in the MARC record, so
2922 # we'll create it if $cn_sort is not empty -- this would be
2923 # an odd combination of events, however
2924 if ($cn_sort) {
2925 $marc->insert_grouped_field( MARC::Field->new( $biblioitem_tag, ' ', ' ', $biblioitem_subfield => $cn_sort ) );
2926 }
2927 }
2928}
2929
2930=head2 _koha_add_biblio
2931
- -
2938sub _koha_add_biblio {
2939 my ( $dbh, $biblio, $frameworkcode ) = @_;
2940
2941 my $error;
2942
2943 # set the series flag
2944 unless (defined $biblio->{'serial'}){
2945 $biblio->{'serial'} = 0;
2946 if ( $biblio->{'seriestitle'} ) { $biblio->{'serial'} = 1 }
2947 }
2948
2949 my $query = "INSERT INTO biblio
2950 SET frameworkcode = ?,
2951 author = ?,
2952 title = ?,
2953 unititle =?,
2954 notes = ?,
2955 serial = ?,
2956 seriestitle = ?,
2957 copyrightdate = ?,
2958 datecreated=NOW(),
2959 abstract = ?
2960 ";
2961 my $sth = $dbh->prepare($query);
2962 $sth->execute(
2963 $frameworkcode, $biblio->{'author'}, $biblio->{'title'}, $biblio->{'unititle'}, $biblio->{'notes'},
2964 $biblio->{'serial'}, $biblio->{'seriestitle'}, $biblio->{'copyrightdate'}, $biblio->{'abstract'}
2965 );
2966
2967 my $biblionumber = $dbh->{'mysql_insertid'};
2968 if ( $dbh->errstr ) {
2969 $error .= "ERROR in _koha_add_biblio $query" . $dbh->errstr;
2970 warn $error;
2971 }
2972
2973 $sth->finish();
2974
2975 #warn "LEAVING _koha_add_biblio: ".$biblionumber."\n";
2976 return ( $biblionumber, $error );
2977}
2978
2979=head2 _koha_modify_biblio
2980
- -
2987sub _koha_modify_biblio {
2988 my ( $dbh, $biblio, $frameworkcode ) = @_;
2989 my $error;
2990
2991 my $query = "
2992 UPDATE biblio
2993 SET frameworkcode = ?,
2994 author = ?,
2995 title = ?,
2996 unititle = ?,
2997 notes = ?,
2998 serial = ?,
2999 seriestitle = ?,
3000 copyrightdate = ?,
3001 abstract = ?
3002 WHERE biblionumber = ?
3003 "
3004 ;
3005 my $sth = $dbh->prepare($query);
3006
3007 $sth->execute(
3008 $frameworkcode, $biblio->{'author'}, $biblio->{'title'}, $biblio->{'unititle'}, $biblio->{'notes'},
3009 $biblio->{'serial'}, $biblio->{'seriestitle'}, $biblio->{'copyrightdate'}, $biblio->{'abstract'}, $biblio->{'biblionumber'}
3010 ) if $biblio->{'biblionumber'};
3011
3012 if ( $dbh->errstr || !$biblio->{'biblionumber'} ) {
3013 $error .= "ERROR in _koha_modify_biblio $query" . $dbh->errstr;
3014 warn $error;
3015 }
3016 return ( $biblio->{'biblionumber'}, $error );
3017}
3018
3019=head2 _koha_modify_biblioitem_nonmarc
3020
- -
3028sub _koha_modify_biblioitem_nonmarc {
3029 my ( $dbh, $biblioitem ) = @_;
3030 my $error;
3031
3032 # re-calculate the cn_sort, it may have changed
3033 my ($cn_sort) = GetClassSort( $biblioitem->{'biblioitems.cn_source'}, $biblioitem->{'cn_class'}, $biblioitem->{'cn_item'} );
3034
3035 my $query = "UPDATE biblioitems
3036 SET biblionumber = ?,
3037 volume = ?,
3038 number = ?,
3039 itemtype = ?,
3040 isbn = ?,
3041 issn = ?,
3042 publicationyear = ?,
3043 publishercode = ?,
3044 volumedate = ?,
3045 volumedesc = ?,
3046 collectiontitle = ?,
3047 collectionissn = ?,
3048 collectionvolume= ?,
3049 editionstatement= ?,
3050 editionresponsibility = ?,
3051 illus = ?,
3052 pages = ?,
3053 notes = ?,
3054 size = ?,
3055 place = ?,
3056 lccn = ?,
3057 url = ?,
3058 cn_source = ?,
3059 cn_class = ?,
3060 cn_item = ?,
3061 cn_suffix = ?,
3062 cn_sort = ?,
3063 totalissues = ?,
3064 ean = ?,
3065 agerestriction = ?
3066 where biblioitemnumber = ?
3067 ";
3068 my $sth = $dbh->prepare($query);
3069 $sth->execute(
3070 $biblioitem->{'biblionumber'}, $biblioitem->{'volume'}, $biblioitem->{'number'}, $biblioitem->{'itemtype'},
3071 $biblioitem->{'isbn'}, $biblioitem->{'issn'}, $biblioitem->{'publicationyear'}, $biblioitem->{'publishercode'},
3072 $biblioitem->{'volumedate'}, $biblioitem->{'volumedesc'}, $biblioitem->{'collectiontitle'}, $biblioitem->{'collectionissn'},
3073 $biblioitem->{'collectionvolume'}, $biblioitem->{'editionstatement'}, $biblioitem->{'editionresponsibility'}, $biblioitem->{'illus'},
3074 $biblioitem->{'pages'}, $biblioitem->{'bnotes'}, $biblioitem->{'size'}, $biblioitem->{'place'},
3075 $biblioitem->{'lccn'}, $biblioitem->{'url'}, $biblioitem->{'biblioitems.cn_source'}, $biblioitem->{'cn_class'},
3076 $biblioitem->{'cn_item'}, $biblioitem->{'cn_suffix'}, $cn_sort, $biblioitem->{'totalissues'},
3077 $biblioitem->{'ean'}, $biblioitem->{'agerestriction'}, $biblioitem->{'biblioitemnumber'}
3078 );
3079 if ( $dbh->errstr ) {
3080 $error .= "ERROR in _koha_modify_biblioitem_nonmarc $query" . $dbh->errstr;
3081 warn $error;
3082 }
3083 return ( $biblioitem->{'biblioitemnumber'}, $error );
3084}
3085
3086=head2 _koha_add_biblioitem
3087
- -
3094sub _koha_add_biblioitem {
3095 my ( $dbh, $biblioitem ) = @_;
3096 my $error;
3097
3098 my ($cn_sort) = GetClassSort( $biblioitem->{'biblioitems.cn_source'}, $biblioitem->{'cn_class'}, $biblioitem->{'cn_item'} );
3099 my $query = "INSERT INTO biblioitems SET
3100 biblionumber = ?,
3101 volume = ?,
3102 number = ?,
3103 itemtype = ?,
3104 isbn = ?,
3105 issn = ?,
3106 publicationyear = ?,
3107 publishercode = ?,
3108 volumedate = ?,
3109 volumedesc = ?,
3110 collectiontitle = ?,
3111 collectionissn = ?,
3112 collectionvolume= ?,
3113 editionstatement= ?,
3114 editionresponsibility = ?,
3115 illus = ?,
3116 pages = ?,
3117 notes = ?,
3118 size = ?,
3119 place = ?,
3120 lccn = ?,
3121 marc = ?,
3122 url = ?,
3123 cn_source = ?,
3124 cn_class = ?,
3125 cn_item = ?,
3126 cn_suffix = ?,
3127 cn_sort = ?,
3128 totalissues = ?,
3129 ean = ?,
3130 agerestriction = ?
3131 ";
3132 my $sth = $dbh->prepare($query);
3133 $sth->execute(
3134 $biblioitem->{'biblionumber'}, $biblioitem->{'volume'}, $biblioitem->{'number'}, $biblioitem->{'itemtype'},
3135 $biblioitem->{'isbn'}, $biblioitem->{'issn'}, $biblioitem->{'publicationyear'}, $biblioitem->{'publishercode'},
3136 $biblioitem->{'volumedate'}, $biblioitem->{'volumedesc'}, $biblioitem->{'collectiontitle'}, $biblioitem->{'collectionissn'},
3137 $biblioitem->{'collectionvolume'}, $biblioitem->{'editionstatement'}, $biblioitem->{'editionresponsibility'}, $biblioitem->{'illus'},
3138 $biblioitem->{'pages'}, $biblioitem->{'bnotes'}, $biblioitem->{'size'}, $biblioitem->{'place'},
3139 $biblioitem->{'lccn'}, $biblioitem->{'marc'}, $biblioitem->{'url'}, $biblioitem->{'biblioitems.cn_source'},
3140 $biblioitem->{'cn_class'}, $biblioitem->{'cn_item'}, $biblioitem->{'cn_suffix'}, $cn_sort,
3141 $biblioitem->{'totalissues'}, $biblioitem->{'ean'}, $biblioitem->{'agerestriction'}
3142 );
3143 my $bibitemnum = $dbh->{'mysql_insertid'};
3144
3145 if ( $dbh->errstr ) {
3146 $error .= "ERROR in _koha_add_biblioitem $query" . $dbh->errstr;
3147 warn $error;
3148 }
3149 $sth->finish();
3150 return ( $bibitemnum, $error );
3151}
3152
3153=head2 _koha_delete_biblio
3154
- -
3165# FIXME: add error handling
3166
3167sub _koha_delete_biblio {
3168 my ( $dbh, $biblionumber ) = @_;
3169
3170 # get all the data for this biblio
3171 my $sth = $dbh->prepare("SELECT * FROM biblio WHERE biblionumber=?");
3172 $sth->execute($biblionumber);
3173
3174 if ( my $data = $sth->fetchrow_hashref ) {
3175
3176 # save the record in deletedbiblio
3177 # find the fields to save
3178 my $query = "INSERT INTO deletedbiblio SET ";
3179 my @bind = ();
3180 foreach my $temp ( keys %$data ) {
3181 $query .= "$temp = ?,";
3182 push( @bind, $data->{$temp} );
3183 }
3184
3185 # replace the last , by ",?)"
3186 $query =~ s/\,$//;
3187 my $bkup_sth = $dbh->prepare($query);
3188 $bkup_sth->execute(@bind);
3189 $bkup_sth->finish;
3190
3191 # delete the biblio
3192 my $sth2 = $dbh->prepare("DELETE FROM biblio WHERE biblionumber=?");
3193 $sth2->execute($biblionumber);
3194 # update the timestamp (Bugzilla 7146)
3195 $sth2= $dbh->prepare("UPDATE deletedbiblio SET timestamp=NOW() WHERE biblionumber=?");
3196 $sth2->execute($biblionumber);
3197 $sth2->finish;
3198 }
3199 $sth->finish;
3200 return;
3201}
3202
3203=head2 _koha_delete_biblioitems
3204
- -
3214# FIXME: add error handling
3215
3216sub _koha_delete_biblioitems {
3217 my ( $dbh, $biblioitemnumber ) = @_;
3218
3219 # get all the data for this biblioitem
3220 my $sth = $dbh->prepare("SELECT * FROM biblioitems WHERE biblioitemnumber=?");
3221 $sth->execute($biblioitemnumber);
3222
3223 if ( my $data = $sth->fetchrow_hashref ) {
3224
3225 # save the record in deletedbiblioitems
3226 # find the fields to save
3227 my $query = "INSERT INTO deletedbiblioitems SET ";
3228 my @bind = ();
3229 foreach my $temp ( keys %$data ) {
3230 $query .= "$temp = ?,";
3231 push( @bind, $data->{$temp} );
3232 }
3233
3234 # replace the last , by ",?)"
3235 $query =~ s/\,$//;
3236 my $bkup_sth = $dbh->prepare($query);
3237 $bkup_sth->execute(@bind);
3238 $bkup_sth->finish;
3239
3240 # delete the biblioitem
3241 my $sth2 = $dbh->prepare("DELETE FROM biblioitems WHERE biblioitemnumber=?");
3242 $sth2->execute($biblioitemnumber);
3243 # update the timestamp (Bugzilla 7146)
3244 $sth2= $dbh->prepare("UPDATE deletedbiblioitems SET timestamp=NOW() WHERE biblioitemnumber=?");
3245 $sth2->execute($biblioitemnumber);
3246 $sth2->finish;
3247 }
3248 $sth->finish;
3249 return;
3250}
3251
3252=head1 UNEXPORTED FUNCTIONS
3253
- -
3264sub ModBiblioMarc {
3265 # pass the MARC::Record to this function, and it will create the records in
3266 # the marc field
3267 my ( $record, $biblionumber, $frameworkcode ) = @_;
3268
3269 # Clone record as it gets modified
3270 $record = $record->clone();
3271 my $dbh = C4::Context->dbh;
3272 my @fields = $record->fields();
3273 if ( !$frameworkcode ) {
3274 $frameworkcode = "";
3275 }
3276 my $sth = $dbh->prepare("UPDATE biblio SET frameworkcode=? WHERE biblionumber=?");
3277 $sth->execute( $frameworkcode, $biblionumber );
3278 $sth->finish;
3279 my $encoding = C4::Context->preference("marcflavour");
3280
3281 # deal with UNIMARC field 100 (encoding) : create it if needed & set encoding to unicode
3282 if ( $encoding eq "UNIMARC" ) {
3283 my $defaultlanguage = C4::Context->preference("UNIMARCField100Language");
3284 $defaultlanguage = "fre" if (!$defaultlanguage || length($defaultlanguage) != 3);
3285 my $string = $record->subfield( 100, "a" );
3286 if ( ($string) && ( length( $record->subfield( 100, "a" ) ) == 36 ) ) {
3287 my $f100 = $record->field(100);
3288 $record->delete_field($f100);
3289 } else {
3290 $string = POSIX::strftime( "%Y%m%d", localtime );
3291 $string =~ s/\-//g;
3292 $string = sprintf( "%-*s", 35, $string );
3293 substr ( $string, 22, 3, $defaultlanguage);
3294 }
3295 substr( $string, 25, 3, "y50" );
3296 unless ( $record->subfield( 100, "a" ) ) {
3297 $record->insert_fields_ordered( MARC::Field->new( 100, "", "", "a" => $string ) );
3298 }
3299 }
3300
3301 #enhancement 5374: update transaction date (005) for marc21/unimarc
3302 if($encoding =~ /MARC21|UNIMARC/) {
3303 my @a= (localtime) [5,4,3,2,1,0]; $a[0]+=1900; $a[1]++;
3304 # YY MM DD HH MM SS (update year and month)
3305 my $f005= $record->field('005');
3306 $f005->update(sprintf("%4d%02d%02d%02d%02d%04.1f",@a)) if $f005;
3307 }
3308
3309 $sth = $dbh->prepare("UPDATE biblioitems SET marc=?,marcxml=? WHERE biblionumber=?");
3310 $sth->execute( $record->as_usmarc(), $record->as_xml_record($encoding), $biblionumber );
3311 $sth->finish;
3312 ModZebra( $biblionumber, "specialUpdate", "biblioserver" );
3313 return $biblionumber;
3314}
3315
3316=head2 get_biblio_authorised_values
3317
- -
3336sub get_biblio_authorised_values {
3337 my $biblionumber = shift;
3338 my $record = shift;
3339
3340 my $forlibrarian = 1; # are we in staff or opac?
3341 my $frameworkcode = GetFrameworkCode($biblionumber);
3342
3343 my $authorised_values;
3344
3345 my $tagslib = GetMarcStructure( $forlibrarian, $frameworkcode )
3346 or return $authorised_values;
3347
3348 # assume that these entries in the authorised_value table are bibliolevel.
3349 # ones that start with 'item%' are item level.
3350 my $query = q(SELECT distinct authorised_value, kohafield
3351 FROM marc_subfield_structure
3352 WHERE authorised_value !=''
3353 AND (kohafield like 'biblio%'
3354 OR kohafield like '') );
3355 my $bibliolevel_authorised_values = C4::Context->dbh->selectall_hashref( $query, 'authorised_value' );
3356
3357 foreach my $tag ( keys(%$tagslib) ) {
3358 foreach my $subfield ( keys( %{ $tagslib->{$tag} } ) ) {
3359
3360 # warn "checking $subfield. type is: " . ref $tagslib->{ $tag }{ $subfield };
3361 if ( 'HASH' eq ref $tagslib->{$tag}{$subfield} ) {
3362 if ( defined $tagslib->{$tag}{$subfield}{'authorised_value'} && exists $bibliolevel_authorised_values->{ $tagslib->{$tag}{$subfield}{'authorised_value'} } ) {
3363 if ( defined $record->field($tag) ) {
3364 my $this_subfield_value = $record->field($tag)->subfield($subfield);
3365 if ( defined $this_subfield_value ) {
3366 $authorised_values->{ $tagslib->{$tag}{$subfield}{'authorised_value'} } = $this_subfield_value;
3367 }
3368 }
3369 }
3370 }
3371 }
3372 }
3373
3374 # warn ( Data::Dumper->Dump( [ $authorised_values ], [ 'authorised_values' ] ) );
3375 return $authorised_values;
3376}
3377
3378=head2 CountBiblioInOrders
3379
- -
3389sub CountBiblioInOrders {
3390 my ($biblionumber) = @_;
3391 my $dbh = C4::Context->dbh;
3392 my $query = "SELECT count(*)
3393 FROM aqorders
3394 WHERE biblionumber=? AND (datecancellationprinted IS NULL OR datecancellationprinted='0000-00-00')";
3395 my $sth = $dbh->prepare($query);
3396 $sth->execute($biblionumber);
3397 my $count = $sth->fetchrow;
3398 return ($count);
3399}
3400
3401=head2 GetSubscriptionsId
3402
- -
3412sub GetSubscriptionsId {
3413 my ($biblionumber) = @_;
3414 my $dbh = C4::Context->dbh;
3415 my $query = "SELECT subscriptionid
3416 FROM subscription
3417 WHERE biblionumber=?";
3418 my $sth = $dbh->prepare($query);
3419 $sth->execute($biblionumber);
3420 my @subscriptions = $sth->fetchrow_array;
3421 return (@subscriptions);
3422}
3423
3424=head2 GetHolds
3425
- -
3435sub GetHolds {
3436 my ($biblionumber) = @_;
3437 my $dbh = C4::Context->dbh;
3438 my $query = "SELECT count(*)
3439 FROM reserves
3440 WHERE biblionumber=?";
3441 my $sth = $dbh->prepare($query);
3442 $sth->execute($biblionumber);
3443 my $holds = $sth->fetchrow;
3444 return ($holds);
3445}
3446
3447=head2 prepare_host_field
3448
- -
3454sub prepare_host_field {
3455 my ( $hostbiblio, $marcflavour ) = @_;
3456 $marcflavour ||= C4::Context->preference('marcflavour');
3457 my $host = GetMarcBiblio($hostbiblio);
3458 # unfortunately as_string does not 'do the right thing'
3459 # if field returns undef
3460 my %sfd;
3461 my $field;
3462 my $host_field;
3463 if ( $marcflavour eq 'MARC21' || $marcflavour eq 'NORMARC' ) {
3464 if ( $field = $host->field('100') || $host->field('110') || $host->field('11') ) {
3465 my $s = $field->as_string('ab');
3466 if ($s) {
3467 $sfd{a} = $s;
3468 }
3469 }
3470 if ( $field = $host->field('245') ) {
3471 my $s = $field->as_string('a');
3472 if ($s) {
3473 $sfd{t} = $s;
3474 }
3475 }
3476 if ( $field = $host->field('260') ) {
3477 my $s = $field->as_string('abc');
3478 if ($s) {
3479 $sfd{d} = $s;
3480 }
3481 }
3482 if ( $field = $host->field('240') ) {
3483 my $s = $field->as_string();
3484 if ($s) {
3485 $sfd{b} = $s;
3486 }
3487 }
3488 if ( $field = $host->field('022') ) {
3489 my $s = $field->as_string('a');
3490 if ($s) {
3491 $sfd{x} = $s;
3492 }
3493 }
3494 if ( $field = $host->field('020') ) {
3495 my $s = $field->as_string('a');
3496 if ($s) {
3497 $sfd{z} = $s;
3498 }
3499 }
3500 if ( $field = $host->field('001') ) {
3501 $sfd{w} = $field->data(),;
3502 }
3503 $host_field = MARC::Field->new( 773, '0', ' ', %sfd );
3504 return $host_field;
3505 }
3506 elsif ( $marcflavour eq 'UNIMARC' ) {
3507 #author
3508 if ( $field = $host->field('700') || $host->field('710') || $host->field('720') ) {
3509 my $s = $field->as_string('ab');
3510 if ($s) {
3511 $sfd{a} = $s;
3512 }
3513 }
3514 #title
3515 if ( $field = $host->field('200') ) {
3516 my $s = $field->as_string('a');
3517 if ($s) {
3518 $sfd{t} = $s;
3519 }
3520 }
3521 #place of publicaton
3522 if ( $field = $host->field('210') ) {
3523 my $s = $field->as_string('a');
3524 if ($s) {
3525 $sfd{c} = $s;
3526 }
3527 }
3528 #date of publication
3529 if ( $field = $host->field('210') ) {
3530 my $s = $field->as_string('d');
3531 if ($s) {
3532 $sfd{d} = $s;
3533 }
3534 }
3535 #edition statement
3536 if ( $field = $host->field('205') ) {
3537 my $s = $field->as_string();
3538 if ($s) {
3539 $sfd{a} = $s;
3540 }
3541 }
3542 #URL
3543 if ( $field = $host->field('856') ) {
3544 my $s = $field->as_string('u');
3545 if ($s) {
3546 $sfd{u} = $s;
3547 }
3548 }
3549 #ISSN
3550 if ( $field = $host->field('011') ) {
3551 my $s = $field->as_string('a');
3552 if ($s) {
3553 $sfd{x} = $s;
3554 }
3555 }
3556 #ISBN
3557 if ( $field = $host->field('010') ) {
3558 my $s = $field->as_string('a');
3559 if ($s) {
3560 $sfd{y} = $s;
3561 }
3562 }
3563 if ( $field = $host->field('001') ) {
3564 $sfd{0} = $field->data(),;
3565 }
3566 $host_field = MARC::Field->new( 461, '0', ' ', %sfd );
3567 return $host_field;
3568 }
3569 return;
3570}
3571
3572
3573=head2 UpdateTotalIssues
3574
- -
3591sub UpdateTotalIssues {
3592 my ($biblionumber, $increase, $value) = @_;
3593 my $totalissues;
3594
3595 my $data = GetBiblioData($biblionumber);
3596
3597 if (defined $value) {
3598 $totalissues = $value;
3599 } else {
3600 $totalissues = $data->{'totalissues'} + $increase;
3601 }
3602 my ($totalissuestag, $totalissuessubfield) = GetMarcFromKohaField('biblioitems.totalissues', $data->{'frameworkcode'});
3603
3604 my $record = GetMarcBiblio($biblionumber);
3605
3606 my $field = $record->field($totalissuestag);
3607 if (defined $field) {
3608 $field->update( $totalissuessubfield => $totalissues );
3609 } else {
3610 $field = MARC::Field->new($totalissuestag, '0', '0',
3611 $totalissuessubfield => $totalissues);
3612 $record->insert_grouped_field($field);
3613 }
3614
3615 ModBiblio($record, $biblionumber, $data->{'frameworkcode'});
3616 return;
3617}
3618
3619=head2 RemoveAllNsb
3620
- -
3627sub RemoveAllNsb {
3628 my $record = shift;
3629
3630 SetUTF8Flag($record);
3631
3632 foreach my $field ($record->fields()) {
3633 if ($field->is_control_field()) {
3634 $field->update(nsb_clean($field->data()));
3635 } else {
3636 my @subfields = $field->subfields();
3637 my @new_subfields;
3638 foreach my $subfield (@subfields) {
3639 push @new_subfields, $subfield->[0] => nsb_clean($subfield->[1]);
3640 }
3641 if (scalar(@new_subfields) > 0) {
3642 my $new_field;
3643 eval {
3644 $new_field = MARC::Field->new(
3645 $field->tag(),
3646 $field->indicator(1),
3647 $field->indicator(2),
3648 @new_subfields
3649 );
3650 };
3651 if ($@) {
3652 warn "error in RemoveAllNsb : $@";
3653 } else {
3654 $field->replace_with($new_field);
3655 }
3656 }
3657 }
3658 }
3659
3660 return $record;
3661}
3662
3663114µs1;
3664
3665
3666__END__
 
# spent 290µs within C4::Biblio::CORE:match which was called 71 times, avg 4µs/call: # 24 times (73µs+0s) by C4::Biblio::TransformMarcToKoha at line 2553, avg 3µs/call # 24 times (18µs+0s) by C4::Biblio::TransformMarcToKoha at line 2554, avg 754ns/call # 23 times (199µs+0s) by C4::Biblio::TransformMarcToKoha at line 2557, avg 9µs/call
sub C4::Biblio::CORE:match; # opcode
# spent 1.18ms (1.07+109µs) within C4::Biblio::CORE:subst which was called 50 times, avg 24µs/call: # 25 times (1.02ms+109µs) by C4::Biblio::GetCOinSBiblio at line 1436, avg 45µs/call # 25 times (55µs+0s) by C4::Biblio::GetCOinSBiblio at line 1437, avg 2µs/call
sub C4::Biblio::CORE:subst; # opcode
Report produced by the NYTProf 4.04 Perl profiler, developed by Tim Bunce and Adam Kaplan.