← 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 17:10:45 2013
Reported on Tue Oct 15 17:11:25 2013

Filename/usr/share/koha/lib/C4/Biblio.pm
StatementsExecuted 20011 statements in 546ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
251117.6ms31.0msC4::Biblio::::TransformMarcToKohaC4::Biblio::TransformMarcToKoha
2951116.8ms782msC4::Biblio::::GetAuthorisedValueDescC4::Biblio::GetAuthorisedValueDesc
1117.33ms9.31msC4::Biblio::::BEGIN@37C4::Biblio::BEGIN@37
100427.02ms227msC4::Biblio::::GetFrameworkCodeC4::Biblio::GetFrameworkCode
1115.50ms23.6msC4::Biblio::::BEGIN@33C4::Biblio::BEGIN@33
75315.00ms175msC4::Biblio::::GetRecordValueC4::Biblio::GetRecordValue
1113.37ms3.37msC4::Biblio::::_get_inverted_marc_field_mapC4::Biblio::_get_inverted_marc_field_map
25113.21ms35.3msC4::Biblio::::GetCOinSBiblioC4::Biblio::GetCOinSBiblio
843113.17ms3.17msC4::Biblio::::_disambiguateC4::Biblio::_disambiguate
25113.11ms563msC4::Biblio::::GetMarcBiblioC4::Biblio::GetMarcBiblio
1112.63ms3.37msC4::Biblio::::BEGIN@39C4::Biblio::BEGIN@39
1112.56ms47.2msC4::Biblio::::BEGIN@29C4::Biblio::BEGIN@29
1112.44ms5.26msC4::Biblio::::BEGIN@27C4::Biblio::BEGIN@27
25111.57ms62.1msC4::Biblio::::CountItemsIssuedC4::Biblio::CountItemsIssued
1111.54ms3.45msC4::Biblio::::BEGIN@28C4::Biblio::BEGIN@28
1111.43ms65.3msC4::Biblio::::BEGIN@36C4::Biblio::BEGIN@36
25111.26ms15.0msC4::Biblio::::_koha_marc_update_bib_idsC4::Biblio::_koha_marc_update_bib_ids
50211.08ms1.15msC4::Biblio::::CORE:substC4::Biblio::CORE:subst (opcode)
9252983µs14.2msC4::Biblio::::GetMarcFromKohaFieldC4::Biblio::GetMarcFromKohaField
111770µs1.24msC4::Biblio::::BEGIN@38C4::Biblio::BEGIN@38
7131236µs236µsC4::Biblio::::CORE:matchC4::Biblio::CORE:match (opcode)
11155µs55µsC4::Biblio::::BEGIN@43C4::Biblio::BEGIN@43
11124µs73µsC4::Biblio::::BEGIN@34C4::Biblio::BEGIN@34
11121µs99µsC4::Biblio::::BEGIN@30C4::Biblio::BEGIN@30
11120µs56µsC4::Biblio::::BEGIN@31C4::Biblio::BEGIN@31
11118µs22µsC4::Biblio::::BEGIN@22C4::Biblio::BEGIN@22
11118µs236µsC4::Biblio::::BEGIN@35C4::Biblio::BEGIN@35
11115µs80µsC4::Biblio::::BEGIN@41C4::Biblio::BEGIN@41
11112µs24µsC4::Biblio::::BEGIN@23C4::Biblio::BEGIN@23
11110µs62µsC4::Biblio::::BEGIN@24C4::Biblio::BEGIN@24
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::::GetMarcStructureC4::Biblio::GetMarcStructure
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
22328µs226µs
# spent 22µs (18+4) within C4::Biblio::BEGIN@22 which was called: # once (18µs+4µs) by C4::Reserves::BEGIN@27 at line 22
use strict;
# spent 22µs making 1 call to C4::Biblio::BEGIN@22 # spent 4µs making 1 call to strict::import
23325µs237µs
# spent 24µs (12+13) within C4::Biblio::BEGIN@23 which was called: # once (12µs+13µs) by C4::Reserves::BEGIN@27 at line 23
use warnings;
# spent 24µs making 1 call to C4::Biblio::BEGIN@23 # spent 13µs making 1 call to warnings::import
24332µs2114µs
# spent 62µs (10+52) within C4::Biblio::BEGIN@24 which was called: # once (10µs+52µs) by C4::Reserves::BEGIN@27 at line 24
use Carp;
# spent 62µs making 1 call to C4::Biblio::BEGIN@24 # spent 52µs making 1 call to Exporter::import
25
26# use utf8;
273140µs25.29ms
# spent 5.26ms (2.44+2.82) within C4::Biblio::BEGIN@27 which was called: # once (2.44ms+2.82ms) by C4::Reserves::BEGIN@27 at line 27
use MARC::Record;
# spent 5.26ms making 1 call to C4::Biblio::BEGIN@27 # spent 29µs making 1 call to Exporter::import
283151µs23.45ms
# spent 3.45ms (1.54+1.91) within C4::Biblio::BEGIN@28 which was called: # once (1.54ms+1.91ms) by C4::Reserves::BEGIN@27 at line 28
use MARC::File::USMARC;
# spent 3.45ms making 1 call to C4::Biblio::BEGIN@28 # spent 3µs making 1 call to UNIVERSAL::import
293178µs247.2ms
# spent 47.2ms (2.56+44.6) within C4::Biblio::BEGIN@29 which was called: # once (2.56ms+44.6ms) by C4::Reserves::BEGIN@27 at line 29
use MARC::File::XML;
# spent 47.2ms making 1 call to C4::Biblio::BEGIN@29 # spent 13µs making 1 call to MARC::File::XML::import
30343µs2176µs
# spent 99µs (21+78) within C4::Biblio::BEGIN@30 which was called: # once (21µs+78µs) by C4::Reserves::BEGIN@27 at line 30
use POSIX qw(strftime);
# spent 99µs making 1 call to C4::Biblio::BEGIN@30 # spent 78µs making 1 call to POSIX::import
31340µs291µs
# spent 56µs (20+35) within C4::Biblio::BEGIN@31 which was called: # once (20µs+35µs) by C4::Reserves::BEGIN@27 at line 31
use Module::Load::Conditional qw(can_load);
# spent 56µs making 1 call to C4::Biblio::BEGIN@31 # spent 35µs making 1 call to Exporter::import
32
333202µs224.2ms
# spent 23.6ms (5.50+18.1) within C4::Biblio::BEGIN@33 which was called: # once (5.50ms+18.1ms) by C4::Reserves::BEGIN@27 at line 33
use C4::Koha;
# spent 23.6ms making 1 call to C4::Biblio::BEGIN@33 # spent 633µs making 1 call to Exporter::import
34343µs2123µs
# spent 73µs (24+50) within C4::Biblio::BEGIN@34 which was called: # once (24µs+50µs) by C4::Reserves::BEGIN@27 at line 34
use C4::Dates qw/format_date/;
# spent 73µs making 1 call to C4::Biblio::BEGIN@34 # spent 50µs making 1 call to Exporter::import
35344µs2455µs
# spent 236µs (18+218) within C4::Biblio::BEGIN@35 which was called: # once (18µs+218µs) by C4::Reserves::BEGIN@27 at line 35
use C4::Log; # logaction
# spent 236µs making 1 call to C4::Biblio::BEGIN@35 # spent 218µs making 1 call to Exporter::import
363190µs265.6ms
# spent 65.3ms (1.43+63.8) within C4::Biblio::BEGIN@36 which was called: # once (1.43ms+63.8ms) by C4::Reserves::BEGIN@27 at line 36
use C4::ClassSource;
# spent 65.3ms making 1 call to C4::Biblio::BEGIN@36 # spent 366µs making 1 call to Exporter::import
373241µs29.61ms
# spent 9.31ms (7.33+1.98) within C4::Biblio::BEGIN@37 which was called: # once (7.33ms+1.98ms) by C4::Reserves::BEGIN@27 at line 37
use C4::Charset;
# spent 9.31ms making 1 call to C4::Biblio::BEGIN@37 # spent 299µs making 1 call to Exporter::import
383241µs21.25ms
# spent 1.24ms (770µs+470µs) within C4::Biblio::BEGIN@38 which was called: # once (770µs+470µs) by C4::Reserves::BEGIN@27 at line 38
use C4::Linker;
# spent 1.24ms making 1 call to C4::Biblio::BEGIN@38 # spent 12µs making 1 call to Class::Accessor::import
393238µs23.78ms
# spent 3.37ms (2.63+735µs) within C4::Biblio::BEGIN@39 which was called: # once (2.63ms+735µs) by C4::Reserves::BEGIN@27 at line 39
use C4::OAI::Sets;
# spent 3.37ms making 1 call to C4::Biblio::BEGIN@39 # spent 418µs making 1 call to Exporter::import
40
413224µs2145µs
# spent 80µs (15+65) within C4::Biblio::BEGIN@41 which was called: # once (15µs+65µs) by C4::Reserves::BEGIN@27 at line 41
use vars qw($VERSION @ISA @EXPORT);
# spent 80µs making 1 call to C4::Biblio::BEGIN@41 # spent 65µs making 1 call to vars::import
42
43
# spent 55µs within C4::Biblio::BEGIN@43 which was called: # once (55µs+0s) by C4::Reserves::BEGIN@27 at line 141
BEGIN {
441060µs $VERSION = 3.07.00.049;
45
46 require Exporter;
47 @ISA = qw( Exporter );
48
49 # to add biblios
50 # EXPORTED FUNCTIONS.
51 push @EXPORT, qw(
52 &AddBiblio
53 );
54
55 # to get something
56 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
105 push @EXPORT, qw(
106 &ModBiblio
107 &ModBiblioframework
108 &ModZebra
109 &UpdateTotalIssues
110 &RemoveAllNsb
111 );
112
113 # To delete something
114 push @EXPORT, qw(
115 &DelBiblio
116 );
117
118 # To link headings in a bib record
119 # to authority records.
120 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 ;-)
129 push @EXPORT, qw(
130 &ModBiblioMarc
131 );
132
133 # Others functions
134 push @EXPORT, qw(
135 &TransformMarcToKoha
136 &TransformHtmlToMarc2
137 &TransformHtmlToMarc
138 &TransformHtmlToXml
139 prepare_host_field
140 );
141121.4ms155µs}
# spent 55µs making 1 call to C4::Biblio::BEGIN@43
142
14314µseval {
144119µs111µs if (C4::Context->ismemcached) {
# spent 11µs making 1 call to C4::Context::ismemcached
14512µs require Memoize::Memcached;
146118µs1359µs import Memoize::Memcached qw(memoize_memcached);
# spent 359µs making 1 call to Memoize::Memcached::import
147
148111µs21.33ms memoize_memcached( 'GetMarcStructure',
# spent 1.32ms making 1 call to Memoize::Memcached::memoize_memcached # spent 6µs making 1 call to C4::Context::memcached
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 175ms (5.00+170) within C4::Biblio::GetRecordValue which was called 75 times, avg 2.33ms/call: # 25 times (1.67ms+60.8ms) by C4::Search::searchResults at line 1709 of /usr/share/koha/lib/C4/Search.pm, avg 2.50ms/call # 25 times (1.95ms+56.0ms) by C4::Search::searchResults at line 1708 of /usr/share/koha/lib/C4/Search.pm, avg 2.32ms/call # 25 times (1.38ms+53.3ms) by C4::Search::searchResults at line 1710 of /usr/share/koha/lib/C4/Search.pm, avg 2.19ms/call
sub GetRecordValue {
67552594.2ms my ( $field, $record, $frameworkcode ) = @_;
6767574.0ms my $dbh = C4::Context->dbh;
# spent 74.0ms making 75 calls to C4::Context::dbh, avg 987µs/call
677
6781366µs15013.4ms my $sth = $dbh->prepare('SELECT fieldcode, subfieldcode FROM fieldmapping WHERE frameworkcode = ? AND field = ?');
# spent 7.21ms making 75 calls to DBI::db::prepare, avg 96µs/call # spent 6.18ms making 75 calls to DBD::mysql::db::prepare, avg 82µs/call
6797584.3ms $sth->execute( $frameworkcode, $field );
# spent 84.3ms making 75 calls to DBI::st::execute, avg 1.12ms/call
680
681 my @result = ();
682
6832255.19ms while ( my $row = $sth->fetchrow_hashref ) {
# spent 3.57ms making 75 calls to DBI::st::fetchrow_hashref, avg 48µs/call # spent 1.02ms making 75 calls to DBI::common::FETCH, avg 14µs/call # spent 599µs making 75 calls to DBI::st::fetch, avg 8µ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
696 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
10781800nsour $marc_structure_cache;
1079
1080sub GetMarcStructure {
1081 my ( $forlibrarian, $frameworkcode ) = @_;
1082 my $dbh = C4::Context->dbh;
1083 $frameworkcode = "" unless $frameworkcode;
1084
1085 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 );
1094 my $sth = $dbh->prepare(
1095 "SELECT tagfield,liblibrarian,libopac,mandatory,repeatable
1096 FROM marc_tag_structure
1097 WHERE frameworkcode=?
1098 ORDER BY tagfield"
1099 );
1100 $sth->execute($frameworkcode);
1101 my ( $liblibrarian, $libopac, $tag, $res, $tab, $mandatory, $repeatable );
1102
1103 while ( ( $tag, $liblibrarian, $libopac, $mandatory, $repeatable ) = $sth->fetchrow ) {
1104 $res->{$tag}->{lib} = ( $forlibrarian or !$libopac ) ? $liblibrarian : $libopac;
1105 $res->{$tag}->{tab} = "";
1106 $res->{$tag}->{mandatory} = $mandatory;
1107 $res->{$tag}->{repeatable} = $repeatable;
1108 }
1109
1110 $sth = $dbh->prepare(
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
1118 $sth->execute($frameworkcode);
1119
1120 my $subfield;
1121 my $authorised_value;
1122 my $authtypecode;
1123 my $value_builder;
1124 my $kohafield;
1125 my $seealso;
1126 my $hidden;
1127 my $isurl;
1128 my $link;
1129 my $defaultvalue;
1130 my $maxlength;
1131
1132 while (
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 ) {
1139 $res->{$tag}->{$subfield}->{lib} = ( $forlibrarian or !$libopac ) ? $liblibrarian : $libopac;
1140 $res->{$tag}->{$subfield}->{tab} = $tab;
1141 $res->{$tag}->{$subfield}->{mandatory} = $mandatory;
1142 $res->{$tag}->{$subfield}->{repeatable} = $repeatable;
1143 $res->{$tag}->{$subfield}->{authorised_value} = $authorised_value;
1144 $res->{$tag}->{$subfield}->{authtypecode} = $authtypecode;
1145 $res->{$tag}->{$subfield}->{value_builder} = $value_builder;
1146 $res->{$tag}->{$subfield}->{kohafield} = $kohafield;
1147 $res->{$tag}->{$subfield}->{seealso} = $seealso;
1148 $res->{$tag}->{$subfield}->{hidden} = $hidden;
1149 $res->{$tag}->{$subfield}->{isurl} = $isurl;
1150 $res->{$tag}->{$subfield}->{'link'} = $link;
1151 $res->{$tag}->{$subfield}->{defaultvalue} = $defaultvalue;
1152 $res->{$tag}->{$subfield}->{maxlength} = $maxlength;
1153 }
1154
1155 $marc_structure_cache->{$forlibrarian}->{$frameworkcode} = $res;
1156
1157 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 14.2ms (983µs+13.2) within C4::Biblio::GetMarcFromKohaField which was called 92 times, avg 154µs/call: # 40 times (273µs+98µs) by C4::Search::searchResults at line 1681 of /usr/share/koha/lib/C4/Search.pm, avg 9µs/call # 25 times (472µs+250µs) by C4::Biblio::_koha_marc_update_bib_ids at line 2846, avg 29µs/call # 25 times (213µs+62µs) by C4::Biblio::_koha_marc_update_bib_ids at line 2848, avg 11µs/call # once (19µs+12.8ms) by C4::Search::searchResults at line 1674 of /usr/share/koha/lib/C4/Search.pm # once (6µs+2µs) by C4::Search::searchResults at line 1697 of /usr/share/koha/lib/C4/Search.pm
sub GetMarcFromKohaField {
1198466908µs my $kohafield = shift;
1199 my $frameworkcode = shift || '';
1200 return (0, undef) unless $kohafield;
12019213.2ms my $relations = C4::Context->marcfromkohafield;
# spent 13.2ms making 92 calls to C4::Context::marcfromkohafield, avg 144µs/call
1202 if ( my $mf = $relations->{$frameworkcode}->{$kohafield} ) {
1203 return @$mf;
1204 }
1205 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 563ms (3.11+560) within C4::Biblio::GetMarcBiblio which was called 25 times, avg 22.5ms/call: # 25 times (3.11ms+560ms) by main::RUNTIME at line 588 of /usr/share/koha/opac/cgi-bin/opac/opac-search.pl, avg 22.5ms/call
sub GetMarcBiblio {
125242541.6ms my $biblionumber = shift;
1253 my $embeditems = shift || 0;
12542524.8ms my $dbh = C4::Context->dbh;
# spent 24.8ms making 25 calls to C4::Context::dbh, avg 993µs/call
12551187µs505.08ms my $sth = $dbh->prepare("SELECT marcxml FROM biblioitems WHERE biblionumber=? ");
# spent 2.73ms making 25 calls to DBI::db::prepare, avg 109µs/call # spent 2.35ms making 25 calls to DBD::mysql::db::prepare, avg 94µs/call
12562535.9ms $sth->execute($biblionumber);
# spent 35.9ms making 25 calls to DBI::st::execute, avg 1.44ms/call
1257752.21ms my $row = $sth->fetchrow_hashref;
# spent 1.50ms making 25 calls to DBI::st::fetchrow_hashref, avg 60µs/call # spent 389µs making 25 calls to DBI::st::fetch, avg 16µs/call # spent 316µs making 25 calls to DBI::common::FETCH, avg 13µs/call
12582510.0ms my $marcxml = StripNonXmlChars( $row->{'marcxml'} );
# spent 10.0ms making 25 calls to C4::Charset::StripNonXmlChars, avg 402µs/call
125950505µs MARC::File::XML->default_record_format( C4::Context->preference('marcflavour') );
# spent 256µs making 25 calls to MARC::File::XML::default_record_format, avg 10µs/call # spent 249µs making 25 calls to C4::Context::preference, avg 10µs/call
126025402µs my $record = MARC::Record->new();
# spent 402µs making 25 calls to MARC::Record::new, avg 16µs/call
1261
1262 if ($marcxml) {
126350468ms $record = eval { MARC::Record::new_from_xml( $marcxml, "utf8", C4::Context->preference('marcflavour') ) };
# spent 468ms making 25 calls to MARC::Record::new_from_xml, avg 18.7ms/call # spent 130µs making 25 calls to C4::Context::preference, avg 5µs/call
1264 if ($@) { warn " problem with :$biblionumber : $@ \n$marcxml"; }
1265 return unless $record;
1266
12672515.0ms C4::Biblio::_koha_marc_update_bib_ids($record, '', $biblionumber, $biblionumber);
# spent 15.0ms making 25 calls to C4::Biblio::_koha_marc_update_bib_ids, avg 599µs/call
1268 C4::Biblio::EmbedItemsInMarcBiblio($record, $biblionumber) if ($embeditems);
1269
1270 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 35.3ms (3.21+32.1) within C4::Biblio::GetCOinSBiblio which was called 25 times, avg 1.41ms/call: # 25 times (3.21ms+32.1ms) by main::RUNTIME at line 589 of /usr/share/koha/opac/cgi-bin/opac/opac-search.pl, avg 1.41ms/call
sub GetCOinSBiblio {
13039913.82ms my $record = shift;
1304
1305 # get the coin format
1306 if ( ! $record ) {
1307 return;
1308 }
130925209µs my $pos7 = substr $record->leader(), 7, 1;
# spent 209µs making 25 calls to MARC::Record::leader, avg 8µs/call
13102565µs my $pos6 = substr $record->leader(), 6, 1;
# spent 65µs making 25 calls to MARC::Record::leader, avg 3µs/call
1311 my $mtx;
1312 my $genre;
1313 my ( $aulast, $aufirst ) = ( '', '' );
1314 my $oauthors = '';
1315 my $title = '';
1316 my $subtitle = '';
1317 my $pubyear = '';
1318 my $isbn = '';
1319 my $issn = '';
1320 my $publisher = '';
1321 my $pages = '';
1322 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
1326 my $fmts6;
1327 my $fmts7;
1328 %$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 );
1344 %$fmts7 = (
1345 'a' => 'journalArticle',
1346 's' => 'journal',
1347 );
1348
1349 $genre = $fmts6->{$pos6} ? $fmts6->{$pos6} : 'book';
1350
1351 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 ####
1356 if ( $genre eq 'book' ) {
1357 $mtx = 'book';
1358 } elsif ( $genre eq 'journal' ) {
1359 $mtx = 'journal';
1360 $titletype = 'j';
1361 } elsif ( $genre eq 'journalArticle' ) {
1362 $mtx = 'journal';
1363 $genre = 'article';
1364 $titletype = 'a';
1365 } else {
1366 $mtx = 'dc';
1367 }
1368
1369 $genre = ( $mtx eq 'dc' ) ? "&amp;rft.type=$genre" : "&amp;rft.genre=$genre";
1370
137125244µs if ( C4::Context->preference("marcflavour") eq "UNIMARC" ) {
# spent 244µs making 25 calls to C4::Context::preference, avg 10µ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
1397364.93ms if ( $record->field('100') ) {
# spent 4.01ms making 25 calls to MARC::Record::field, avg 160µs/call # spent 918µs making 11 calls to MARC::Record::subfield, avg 83µs/call
1398 $oauthors .= "&amp;rft.au=" . $record->subfield( '100', 'a' );
1399 }
1400
1401 # others authors
1402435.36ms if ( $record->field('700') ) {
# spent 5.21ms making 34 calls to MARC::Record::field, avg 153µs/call # spent 152µs making 9 calls to MARC::Field::subfield, avg 17µs/call
1403 for my $au ( $record->field('700')->subfield('a') ) {
1404 $oauthors .= "&amp;rft.au=$au";
1405 }
1406 }
1407252.26ms $title = "&amp;rft." . $titletype . "title=" . $record->subfield( '245', 'a' );
# spent 2.26ms making 25 calls to MARC::Record::subfield, avg 90µs/call
1408252.15ms $subtitle = $record->subfield( '245', 'b' ) || '';
# spent 2.15ms making 25 calls to MARC::Record::subfield, avg 86µs/call
1409 $title .= $subtitle;
1410 if ($titletype eq 'a') {
14111243µs $pubyear = $record->field('008') || '';
# spent 243µs making 1 call to MARC::Record::field
1412 $pubyear = substr($pubyear->data(), 7, 4) if $pubyear;
14131188µs $isbn = $record->subfield( '773', 'z' ) || '';
# spent 188µs making 1 call to MARC::Record::subfield
14141186µs $issn = $record->subfield( '773', 'x' ) || '';
# spent 186µs making 1 call to MARC::Record::subfield
14151186µs if ($mtx eq 'journal') {
# spent 186µ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 }
14201224µs foreach my $rel ($record->subfield( '773', 'g' )) {
# spent 224µs making 1 call to MARC::Record::subfield
1421 if ($pages) {
1422 $pages .= ', ';
1423 }
1424 $pages .= $rel;
1425 }
1426 } else {
1427242.41ms $pubyear = $record->subfield( '260', 'c' ) || '';
# spent 2.41ms making 24 calls to MARC::Record::subfield, avg 101µs/call
1428242.39ms $publisher = $record->subfield( '260', 'b' ) || '';
# spent 2.39ms making 24 calls to MARC::Record::subfield, avg 100µs/call
1429245.52ms $isbn = $record->subfield( '020', 'a' ) || '';
# spent 5.52ms making 24 calls to MARC::Record::subfield, avg 230µs/call
1430244.39ms $issn = $record->subfield( '022', 'a' ) || '';
# spent 4.39ms making 24 calls to MARC::Record::subfield, avg 183µs/call
1431 }
1432
1433 }
1434 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";
1436137µs261.18ms $coins_value =~ s/(\ |&[^a])/\+/g;
# spent 1.10ms making 25 calls to C4::Biblio::CORE:subst, avg 44µs/call # spent 78µs making 1 call to utf8::SWASHNEW
14372552µs $coins_value =~ s/\"/\&quot\;/g;
# spent 52µ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
1441 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 782ms (16.8+765) within C4::Biblio::GetAuthorisedValueDesc which was called 295 times, avg 2.65ms/call: # 295 times (16.8ms+765ms) by C4::XSLT::transformMARCXML4XSLT at line 92 of /usr/share/koha/lib/C4/XSLT.pm, avg 2.65ms/call
sub GetAuthorisedValueDesc {
15722750203ms my ( $tag, $subfield, $value, $framework, $tagslib, $category, $opac ) = @_;
1573295291ms my $dbh = C4::Context->dbh;
# spent 291ms making 295 calls to C4::Context::dbh, avg 987µs/call
1574
1575 if ( !$category ) {
1576
1577 return $value unless defined $tagslib->{$tag}->{$subfield}->{'authorised_value'};
1578
1579 #---- branch
1580256141ms if ( $tagslib->{$tag}->{$subfield}->{'authorised_value'} eq "branches" ) {
# spent 141ms making 64 calls to C4::Branch::GetBranchName, avg 2.20ms/call # spent 739µs making 128 calls to DBI::common::DESTROY, avg 6µs/call # spent 191µs making 64 calls to DBD::_mem::common::DESTROY, avg 3µs/call
1581 return C4::Branch::GetBranchName($value);
1582 }
1583
1584 #---- itemtypes
1585228133ms if ( $tagslib->{$tag}->{$subfield}->{'authorised_value'} eq "itemtypes" ) {
# spent 132ms making 57 calls to C4::Koha::getitemtypeinfo, avg 2.32ms/call # spent 971µs making 114 calls to DBI::common::DESTROY, avg 9µs/call # spent 268µs making 57 calls to DBD::_mem::common::DESTROY, avg 5µs/call
1586 return getitemtypeinfo($value)->{description};
1587 }
1588
1589 #---- "true" authorized value
1590 $category = $tagslib->{$tag}->{$subfield}->{'authorised_value'};
1591 }
1592
1593 if ( $category ne "" ) {
159411.15ms34830.9ms my $sth = $dbh->prepare( "SELECT lib, lib_opac FROM authorised_values WHERE category = ? AND authorised_value = ?" );
# spent 16.6ms making 174 calls to DBI::db::prepare, avg 96µs/call # spent 14.3ms making 174 calls to DBD::mysql::db::prepare, avg 82µs/call
1595174174ms $sth->execute( $category, $value );
# spent 174ms making 174 calls to DBI::st::execute, avg 1000µs/call
159652212.0ms my $data = $sth->fetchrow_hashref;
# spent 8.35ms making 174 calls to DBI::st::fetchrow_hashref, avg 48µs/call # spent 2.05ms making 174 calls to DBI::common::FETCH, avg 12µs/call # spent 1.60ms making 174 calls to DBI::st::fetch, avg 9µs/call
1597 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 227ms (7.02+219) within C4::Biblio::GetFrameworkCode which was called 100 times, avg 2.27ms/call: # 25 times (1.84ms+64.9ms) by C4::Search::searchResults at line 1702 of /usr/share/koha/lib/C4/Search.pm, avg 2.67ms/call # 25 times (1.74ms+53.1ms) by C4::XSLT::transformMARCXML4XSLT at line 77 of /usr/share/koha/lib/C4/XSLT.pm, avg 2.19ms/call # 25 times (1.67ms+50.9ms) by C4::XSLT::buildKohaItemsNamespace at line 255 of /usr/share/koha/lib/C4/XSLT.pm, avg 2.10ms/call # 25 times (1.77ms+50.6ms) by C4::XSLT::buildKohaItemsNamespace at line 254 of /usr/share/koha/lib/C4/XSLT.pm, avg 2.10ms/call
sub GetFrameworkCode {
2083600119ms my ($biblionumber) = @_;
208410097.2ms my $dbh = C4::Context->dbh;
# spent 97.2ms making 100 calls to C4::Context::dbh, avg 972µs/call
20851631µs20019.1ms my $sth = $dbh->prepare("SELECT frameworkcode FROM biblio WHERE biblionumber=?");
# spent 10.4ms making 100 calls to DBI::db::prepare, avg 104µs/call # spent 8.66ms making 100 calls to DBD::mysql::db::prepare, avg 87µs/call
2086100109ms $sth->execute($biblionumber);
# spent 109ms making 100 calls to DBI::st::execute, avg 1.09ms/call
20871001.50ms my ($frameworkcode) = $sth->fetchrow;
# spent 1.50ms making 100 calls to DBI::st::fetchrow, avg 15µs/call
2088 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
24781600nsour $inverted_field_map;
2479
2480=head2 TransformMarcToKoha
2481
- -
2489
# spent 31.0ms (17.6+13.4) within C4::Biblio::TransformMarcToKoha which was called 25 times, avg 1.24ms/call: # 25 times (17.6ms+13.4ms) by C4::Search::searchResults at line 1707 of /usr/share/koha/lib/C4/Search.pm, avg 1.24ms/call
sub TransformMarcToKoha {
2490949816.1ms my ( $dbh, $record, $frameworkcode, $limit_table ) = @_;
2491
2492 my $result;
2493 $limit_table = $limit_table || 0;
2494 $frameworkcode = '' unless defined $frameworkcode;
2495
2496 unless ( defined $inverted_field_map ) {
249713.37ms $inverted_field_map = _get_inverted_marc_field_map();
# spent 3.37ms making 1 call to C4::Biblio::_get_inverted_marc_field_map
2498 }
2499
2500 my %tables = ();
2501 if ( defined $limit_table && $limit_table eq 'items' ) {
2502 $tables{'items'} = 1;
2503 } else {
2504 $tables{'items'} = 1;
2505 $tables{'biblio'} = 1;
2506 $tables{'biblioitems'} = 1;
2507 }
2508
2509 # traverse through record
251025227µs MARCFIELD: foreach my $field ( $record->fields() ) {
# spent 227µs making 25 calls to MARC::Record::fields, avg 9µs/call
25115441.67ms my $tag = $field->tag();
# spent 1.67ms making 544 calls to MARC::Field::tag, avg 3µs/call
2512 next MARCFIELD unless exists $inverted_field_map->{$frameworkcode}->{$tag};
2513202582µs if ( $field->is_control_field() ) {
# spent 582µ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
25302024.17ms MARCSUBFIELD: foreach my $sf ( $field->subfields() ) {
# spent 4.17ms making 202 calls to MARC::Field::subfields, avg 21µs/call
2531 my $code = $sf->[0];
2532 next MARCSUBFIELD unless exists $inverted_field_map->{$frameworkcode}->{$tag}->{sfs}->{$code};
2533 my $value = $sf->[1];
2534 SFENTRY: foreach my $entry ( @{ $inverted_field_map->{$frameworkcode}->{$tag}->{sfs}->{$code} } ) {
2535 my ( $table, $column ) = @{$entry};
2536 next SFENTRY unless exists $tables{$table};
25378433.17ms my $key = _disambiguate( $table, $column );
# spent 3.17ms making 843 calls to C4::Biblio::_disambiguate, avg 4µs/call
2538 if ( $result->{$key} ) {
2539 unless ( ( $key eq "biblionumber" or $key eq "biblioitemnumber" ) and ( $value eq "" ) ) {
2540 $result->{$key} .= " | " . $value;
2541 }
2542 } else {
2543 $result->{$key} = $value;
2544 }
2545 }
2546 }
2547 }
2548 }
2549
2550 # modify copyrightdate to keep only the 1st year found
2551 if ( exists $result->{'copyrightdate'} ) {
2552 my $temp = $result->{'copyrightdate'};
25532465µs $temp =~ m/c(\d\d\d\d)/;
# spent 65µs making 24 calls to C4::Biblio::CORE:match, avg 3µs/call
25542415µs if ( $temp =~ m/c(\d\d\d\d)/ and $1 > 0 ) { # search cYYYY first
# spent 15µs making 24 calls to C4::Biblio::CORE:match, avg 629ns/call
2555 $result->{'copyrightdate'} = $1;
2556 } else { # if no cYYYY, get the 1st date.
255723157µs $temp =~ m/(\d\d\d\d)/;
# spent 157µs making 23 calls to C4::Biblio::CORE:match, avg 7µs/call
2558 $result->{'copyrightdate'} = $1;
2559 }
2560 }
2561
2562 # modify publicationyear to keep only the 1st year found
2563 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
2573 return $result;
2574}
2575
2576
# spent 3.37ms (3.37+4µs) within C4::Biblio::_get_inverted_marc_field_map which was called: # once (3.37ms+4µs) by C4::Biblio::TransformMarcToKoha at line 2497
sub _get_inverted_marc_field_map {
257718213.38ms my $field_map = {};
257814µs my $relations = C4::Context->marcfromkohafield;
# spent 4µs making 1 call to C4::Context::marcfromkohafield
2579
2580 foreach my $frameworkcode ( keys %{$relations} ) {
2581 foreach my $kohafield ( keys %{ $relations->{$frameworkcode} } ) {
2582 next unless @{ $relations->{$frameworkcode}->{$kohafield} }; # not all columns are mapped to MARC tag & subfield
2583 my $tag = $relations->{$frameworkcode}->{$kohafield}->[0];
2584 my $subfield = $relations->{$frameworkcode}->{$kohafield}->[1];
2585 my ( $table, $column ) = split /[.]/, $kohafield, 2;
2586 push @{ $field_map->{$frameworkcode}->{$tag}->{list} }, [ $subfield, $table, $column ];
2587 push @{ $field_map->{$frameworkcode}->{$tag}->{sfs}->{$subfield} }, [ $table, $column ];
2588 }
2589 }
2590 return $field_map;
2591}
2592
2593=head2 _disambiguate
2594
- -
2622
# spent 62.1ms (1.57+60.5) within C4::Biblio::CountItemsIssued which was called 25 times, avg 2.48ms/call: # 25 times (1.57ms+60.5ms) by main::RUNTIME at line 580 of /usr/share/koha/opac/cgi-bin/opac/opac-search.pl, avg 2.48ms/call
sub CountItemsIssued {
262315033.0ms my ($biblionumber) = @_;
26242526.8ms my $dbh = C4::Context->dbh;
# spent 26.8ms making 25 calls to C4::Context::dbh, avg 1.07ms/call
26251167µs504.33ms my $sth = $dbh->prepare('SELECT COUNT(*) as issuedCount FROM items, issues WHERE items.itemnumber = issues.itemnumber AND items.biblionumber = ?');
# spent 2.34ms making 25 calls to DBI::db::prepare, avg 94µs/call # spent 1.99ms making 25 calls to DBD::mysql::db::prepare, avg 79µs/call
26262529.5ms $sth->execute($biblionumber);
# spent 29.5ms making 25 calls to DBI::st::execute, avg 1.18ms/call
2627751.94ms my $row = $sth->fetchrow_hashref();
# spent 1.42ms making 25 calls to DBI::st::fetchrow_hashref, avg 57µs/call # spent 315µs making 25 calls to DBI::common::FETCH, avg 13µs/call # spent 203µs making 25 calls to DBI::st::fetch, avg 8µs/call
2628 return $row->{'issuedCount'};
2629}
2630
2631
# spent 3.17ms within C4::Biblio::_disambiguate which was called 843 times, avg 4µs/call: # 843 times (3.17ms+0s) by C4::Biblio::TransformMarcToKoha at line 2537, avg 4µs/call
sub _disambiguate {
263224693.77ms my ( $table, $column ) = @_;
2633 if ( $column eq "cn_sort" or $column eq "cn_source" ) {
2634 return $table . '.' . $column;
2635 } else {
2636 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 15.0ms (1.26+13.7) within C4::Biblio::_koha_marc_update_bib_ids which was called 25 times, avg 599µs/call: # 25 times (1.26ms+13.7ms) by C4::Biblio::GetMarcBiblio at line 1267, avg 599µs/call
sub _koha_marc_update_bib_ids {
28402501.06ms 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.
284625722µs my ( $biblio_tag, $biblio_subfield ) = GetMarcFromKohaField( "biblio.biblionumber", $frameworkcode );
# spent 722µs making 25 calls to C4::Biblio::GetMarcFromKohaField, avg 29µs/call
2847 die qq{No biblionumber tag for framework "$frameworkcode"} unless $biblio_tag;
284825276µs my ( $biblioitem_tag, $biblioitem_subfield ) = GetMarcFromKohaField( "biblioitems.biblioitemnumber", $frameworkcode );
# spent 276µs making 25 calls to C4::Biblio::GetMarcFromKohaField, avg 11µs/call
2849 die qq{No biblioitemnumber tag for framework "$frameworkcode"} unless $biblioitem_tag;
2850
2851 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)
2854251.03ms my $new_field = MARC::Field->new(
# spent 1.03ms making 25 calls to MARC::Field::new, avg 41µs/call
2855 $biblio_tag, '', '',
2856 "$biblio_subfield" => $biblionumber,
2857 "$biblioitem_subfield" => $biblioitemnumber
2858 );
2859
2860 # drop old field and create new one...
2861255.85ms my $old_field = $record->field($biblio_tag);
# spent 5.85ms making 25 calls to MARC::Record::field, avg 234µs/call
286225964µs $record->delete_field($old_field) if $old_field;
# spent 964µs making 25 calls to MARC::Record::delete_field, avg 39µs/call
2863254.87ms $record->insert_fields_ordered($new_field);
# spent 4.87ms making 25 calls to MARC::Record::insert_fields_ordered, avg 195µ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
3663116µs1;
3664
3665
3666__END__
 
# spent 236µs within C4::Biblio::CORE:match which was called 71 times, avg 3µs/call: # 24 times (65µs+0s) by C4::Biblio::TransformMarcToKoha at line 2553, avg 3µs/call # 24 times (15µs+0s) by C4::Biblio::TransformMarcToKoha at line 2554, avg 629ns/call # 23 times (157µs+0s) by C4::Biblio::TransformMarcToKoha at line 2557, avg 7µs/call
sub C4::Biblio::CORE:match; # opcode
# spent 1.15ms (1.08+78µs) within C4::Biblio::CORE:subst which was called 50 times, avg 23µs/call: # 25 times (1.02ms+78µs) by C4::Biblio::GetCOinSBiblio at line 1436, avg 44µs/call # 25 times (52µ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.