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

Filename/mnt/catalyst/koha/C4/Koha.pm
StatementsExecuted 26 statements in 11.2ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
1113.84ms4.47msC4::Koha::::BEGIN@27C4::Koha::BEGIN@27
1112.88ms10.7msC4::Koha::::BEGIN@28C4::Koha::BEGIN@28
1112.54ms2.75msC4::Koha::::BEGIN@29C4::Koha::BEGIN@29
1111.36ms1.89msC4::Koha::::BEGIN@31C4::Koha::BEGIN@31
1111.31ms20.7msC4::Koha::::BEGIN@30C4::Koha::BEGIN@30
111634µs648µsC4::Koha::::BEGIN@23C4::Koha::BEGIN@23
11113µs16µsC4::Koha::::BEGIN@26C4::Koha::BEGIN@26
11112µs12µsC4::Koha::::BEGIN@36C4::Koha::BEGIN@36
11110µs441µsC4::Koha::::BEGIN@32C4::Koha::BEGIN@32
1117µs55µsC4::Koha::::BEGIN@34C4::Koha::BEGIN@34
0000s0sC4::Koha::::AddAuthorisedValueC4::Koha::AddAuthorisedValue
0000s0sC4::Koha::::GetAuthValCodeC4::Koha::GetAuthValCode
0000s0sC4::Koha::::GetAuthValCodeFromFieldC4::Koha::GetAuthValCodeFromField
0000s0sC4::Koha::::GetAuthorisedValueByCodeC4::Koha::GetAuthorisedValueByCode
0000s0sC4::Koha::::GetAuthorisedValueCategoriesC4::Koha::GetAuthorisedValueCategories
0000s0sC4::Koha::::GetAuthorisedValuesC4::Koha::GetAuthorisedValues
0000s0sC4::Koha::::GetDailyQuoteC4::Koha::GetDailyQuote
0000s0sC4::Koha::::GetItemTypesC4::Koha::GetItemTypes
0000s0sC4::Koha::::GetKohaAuthorisedValueLibC4::Koha::GetKohaAuthorisedValueLib
0000s0sC4::Koha::::GetKohaAuthorisedValuesC4::Koha::GetKohaAuthorisedValues
0000s0sC4::Koha::::GetKohaAuthorisedValuesFromFieldC4::Koha::GetKohaAuthorisedValuesFromField
0000s0sC4::Koha::::GetKohaImageurlFromAuthorisedValuesC4::Koha::GetKohaImageurlFromAuthorisedValues
0000s0sC4::Koha::::GetNormalizedEANC4::Koha::GetNormalizedEAN
0000s0sC4::Koha::::GetNormalizedISBNC4::Koha::GetNormalizedISBN
0000s0sC4::Koha::::GetNormalizedOCLCNumberC4::Koha::GetNormalizedOCLCNumber
0000s0sC4::Koha::::GetNormalizedUPCC4::Koha::GetNormalizedUPC
0000s0sC4::Koha::::GetPrinterC4::Koha::GetPrinter
0000s0sC4::Koha::::GetPrintersC4::Koha::GetPrinters
0000s0sC4::Koha::::GetSupportListC4::Koha::GetSupportList
0000s0sC4::Koha::::GetSupportNameC4::Koha::GetSupportName
0000s0sC4::Koha::::IsAuthorisedValueCategoryC4::Koha::IsAuthorisedValueCategory
0000s0sC4::Koha::::_getImagesFromDirectoryC4::Koha::_getImagesFromDirectory
0000s0sC4::Koha::::_getSubdirectoryNamesC4::Koha::_getSubdirectoryNames
0000s0sC4::Koha::::_isbn_cleanupC4::Koha::_isbn_cleanup
0000s0sC4::Koha::::_normalize_match_pointC4::Koha::_normalize_match_point
0000s0sC4::Koha::::displayServersC4::Koha::displayServers
0000s0sC4::Koha::::display_marc_indicatorsC4::Koha::display_marc_indicators
0000s0sC4::Koha::::getFacetsC4::Koha::getFacets
0000s0sC4::Koha::::getImageSetsC4::Koha::getImageSets
0000s0sC4::Koha::::get_infos_ofC4::Koha::get_infos_of
0000s0sC4::Koha::::get_itemtypeinfos_ofC4::Koha::get_itemtypeinfos_of
0000s0sC4::Koha::::get_notforloan_label_ofC4::Koha::get_notforloan_label_of
0000s0sC4::Koha::::getallthemesC4::Koha::getallthemes
0000s0sC4::Koha::::getauthtypeC4::Koha::getauthtype
0000s0sC4::Koha::::getauthtypesC4::Koha::getauthtypes
0000s0sC4::Koha::::getframeworkinfoC4::Koha::getframeworkinfo
0000s0sC4::Koha::::getframeworksC4::Koha::getframeworks
0000s0sC4::Koha::::getitemtypeimagedirC4::Koha::getitemtypeimagedir
0000s0sC4::Koha::::getitemtypeimagelocationC4::Koha::getitemtypeimagelocation
0000s0sC4::Koha::::getitemtypeimagesrcC4::Koha::getitemtypeimagesrc
0000s0sC4::Koha::::getitemtypeinfoC4::Koha::getitemtypeinfo
0000s0sC4::Koha::::getnbpagesC4::Koha::getnbpages
0000s0sC4::Koha::::slashifyDateC4::Koha::slashifyDate
0000s0sC4::Koha::::subfield_is_koha_internal_pC4::Koha::subfield_is_koha_internal_p
0000s0sC4::Koha::::xml_escapeC4::Koha::xml_escape
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments		 Time
on line		 Calls Time
in subs		 Code
1package C4::Koha;
2
3# Copyright 2000-2002 Katipo Communications
4# Parts Copyright 2010 Nelsonville Public Library
5# Parts copyright 2010 BibLibre
6#
7# This file is part of Koha.
8#
9# Koha is free software; you can redistribute it and/or modify it under the
10# terms of the GNU General Public License as published by the Free Software
11# Foundation; either version 2 of the License, or (at your option) any later
12# version.
13#
14# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
15# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
16# A PARTICULAR PURPOSE. See the GNU General Public License for more details.
17#
18# You should have received a copy of the GNU General Public License along
19# with Koha; if not, write to the Free Software Foundation, Inc.,
20# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
21
22
23230µs2661µs
# spent 648µs (634+14) within C4::Koha::BEGIN@23 which was called: # once (634µs+14µs) by C4::Biblio::BEGIN@33 at line 23
use strict;
# spent 648µs making 1 call to C4::Koha::BEGIN@23 # spent 14µs making 1 call to strict::import
24#use warnings; FIXME - Bug 2505
25
26227µs219µs
# spent 16µs (13+3) within C4::Koha::BEGIN@26 which was called: # once (13µs+3µs) by C4::Biblio::BEGIN@33 at line 26
use C4::Context;
# spent 16µs making 1 call to C4::Koha::BEGIN@26 # spent 3µs making 1 call to C4::Context::import
2722.32ms24.55ms
# spent 4.47ms (3.84+630µs) within C4::Koha::BEGIN@27 which was called: # once (3.84ms+630µs) by C4::Biblio::BEGIN@33 at line 27
use C4::Branch qw(GetBranchesCount);
# spent 4.47ms making 1 call to C4::Koha::BEGIN@27 # spent 73µs making 1 call to Exporter::import
2822.27ms210.7ms
# spent 10.7ms (2.88+7.83) within C4::Koha::BEGIN@28 which was called: # once (2.88ms+7.83ms) by C4::Biblio::BEGIN@33 at line 28
use Koha::DateUtils qw(dt_from_string);
# spent 10.7ms making 1 call to C4::Koha::BEGIN@28 # spent 29µs making 1 call to Exporter::import
292816µs22.77ms
# spent 2.75ms (2.54+211µs) within C4::Koha::BEGIN@29 which was called: # once (2.54ms+211µs) by C4::Biblio::BEGIN@33 at line 29
use Memoize;
# spent 2.75ms making 1 call to C4::Koha::BEGIN@29 # spent 22µs making 1 call to Exporter::import
302875µs120.7ms
# spent 20.7ms (1.31+19.4) within C4::Koha::BEGIN@30 which was called: # once (1.31ms+19.4ms) by C4::Biblio::BEGIN@33 at line 30
use DateTime::Format::MySQL;
# spent 20.7ms making 1 call to C4::Koha::BEGIN@30
312960µs22.38ms
# spent 1.89ms (1.36+534µs) within C4::Koha::BEGIN@31 which was called: # once (1.36ms+534µs) by C4::Biblio::BEGIN@33 at line 31
use autouse 'Data::Dumper' => qw(Dumper);
# spent 1.89ms making 1 call to C4::Koha::BEGIN@31 # spent 494µs making 1 call to autouse::import
32233µs2872µs
# spent 441µs (10+431) within C4::Koha::BEGIN@32 which was called: # once (10µs+431µs) by C4::Biblio::BEGIN@33 at line 32
use DBI qw(:sql_types);
# spent 441µs making 1 call to C4::Koha::BEGIN@32 # spent 431µs making 1 call to Exporter::import
33
34276µs2103µs
# spent 55µs (7+48) within C4::Koha::BEGIN@34 which was called: # once (7µs+48µs) by C4::Biblio::BEGIN@33 at line 34
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK $DEBUG);
# spent 55µs making 1 call to C4::Koha::BEGIN@34 # spent 48µs making 1 call to vars::import
35
36
# spent 12µs within C4::Koha::BEGIN@36 which was called: # once (12µs+0s) by C4::Biblio::BEGIN@33 at line 78
BEGIN {
371900ns $VERSION = 3.07.00.049;
381500ns require Exporter;
3915µs @ISA = qw(Exporter);
4012µs @EXPORT = qw(
41 &slashifyDate
42 &subfield_is_koha_internal_p
43 &GetPrinters &GetPrinter
44 &GetItemTypes &getitemtypeinfo
45 &GetSupportName &GetSupportList
46 &get_itemtypeinfos_of
47 &getframeworks &getframeworkinfo
48 &getauthtypes &getauthtype
49 &getallthemes
50 &getFacets
51 &displayServers
52 &getnbpages
53 &get_infos_of
54 &get_notforloan_label_of
55 &getitemtypeimagedir
56 &getitemtypeimagesrc
57 &getitemtypeimagelocation
58 &GetAuthorisedValues
59 &GetAuthorisedValueCategories
60 &IsAuthorisedValueCategory
61 &GetKohaAuthorisedValues
62 &GetKohaAuthorisedValuesFromField
63 &GetKohaAuthorisedValueLib
64 &GetAuthorisedValueByCode
65 &GetKohaImageurlFromAuthorisedValues
66 &GetAuthValCode
67 &AddAuthorisedValue
68 &GetNormalizedUPC
69 &GetNormalizedISBN
70 &GetNormalizedEAN
71 &GetNormalizedOCLCNumber
72 &xml_escape
73
74 $DEBUG
75 );
761200ns $DEBUG = 0;
7713µs@EXPORT_OK = qw( GetDailyQuote );
7813.80ms112µs}
# spent 12µs making 1 call to C4::Koha::BEGIN@36
79
80# expensive functions
8113µs13.23msmemoize('GetAuthorisedValues');
# spent 3.23ms making 1 call to Memoize::memoize
82
83=head1 NAME
84
85C4::Koha - Perl Module containing convenience functions for Koha scripts
86
87=head1 SYNOPSIS
88
89use C4::Koha;
90
91=head1 DESCRIPTION
92
93Koha.pm provides many functions for Koha scripts.
94
95=head1 FUNCTIONS
96
97=cut
98
99=head2 slashifyDate
100
101 $slash_date = &slashifyDate($dash_date);
102
103Takes a string of the form "DD-MM-YYYY" (or anything separated by
104dashes), converts it to the form "YYYY/MM/DD", and returns the result.
105
106=cut
107
108sub slashifyDate {
109
110 # accepts a date of the form xx-xx-xx[xx] and returns it in the
111 # form xx/xx/xx[xx]
112 my @dateOut = split( '-', shift );
113 return ("$dateOut[2]/$dateOut[1]/$dateOut[0]");
114}
115
116# FIXME.. this should be moved to a MARC-specific module
117sub subfield_is_koha_internal_p {
118 my ($subfield) = @_;
119
120 # We could match on 'lib' and 'tab' (and 'mandatory', & more to come!)
121 # But real MARC subfields are always single-character
122 # so it really is safer just to check the length
123
124 return length $subfield != 1;
125}
126
127=head2 GetSupportName
128
129 $itemtypename = &GetSupportName($codestring);
130
131Returns a string with the name of the itemtype.
132
133=cut
134
135sub GetSupportName{
136 my ($codestring)=@_;
137 return if (! $codestring);
138 my $resultstring;
139 my $advanced_search_types = C4::Context->preference("AdvancedSearchTypes");
140 if (!$advanced_search_types or $advanced_search_types eq 'itemtypes') {
141 my $query = qq|
142 SELECT description
143 FROM itemtypes
144 WHERE itemtype=?
145 order by description
146 |;
147 my $sth = C4::Context->dbh->prepare($query);
148 $sth->execute($codestring);
149 ($resultstring)=$sth->fetchrow;
150 return $resultstring;
151 } else {
152 my $sth =
153 C4::Context->dbh->prepare(
154 "SELECT lib FROM authorised_values WHERE category = ? AND authorised_value = ?"
155 );
156 $sth->execute( $advanced_search_types, $codestring );
157 my $data = $sth->fetchrow_hashref;
158 return $$data{'lib'};
159 }
160
161}
162=head2 GetSupportList
163
164 $itemtypes = &GetSupportList();
165
166Returns an array ref containing informations about Support (since itemtype is rather a circulation code when item-level-itypes is used).
167
168build a HTML select with the following code :
169
170=head3 in PERL SCRIPT
171
172 my $itemtypes = GetSupportList();
173 $template->param(itemtypeloop => $itemtypes);
174
175=head3 in TEMPLATE
176
177 <select name="itemtype" id="itemtype">
178 <option value=""></option>
179 [% FOREACH itemtypeloo IN itemtypeloop %]
180 [% IF ( itemtypeloo.selected ) %]
181 <option value="[% itemtypeloo.itemtype %]" selected="selected">[% itemtypeloo.description %]</option>
182 [% ELSE %]
183 <option value="[% itemtypeloo.itemtype %]">[% itemtypeloo.description %]</option>
184 [% END %]
185 [% END %]
186 </select>
187
188=cut
189
190sub GetSupportList{
191 my $advanced_search_types = C4::Context->preference("AdvancedSearchTypes");
192 if (!$advanced_search_types or $advanced_search_types eq 'itemtypes') {
193 my $query = qq|
194 SELECT *
195 FROM itemtypes
196 order by description
197 |;
198 my $sth = C4::Context->dbh->prepare($query);
199 $sth->execute;
200 return $sth->fetchall_arrayref({});
201 } else {
202 my $advsearchtypes = GetAuthorisedValues($advanced_search_types);
203 my @results= map {{itemtype=>$$_{authorised_value},description=>$$_{lib},imageurl=>$$_{imageurl}}} @$advsearchtypes;
204 return \@results;
205 }
206}
207=head2 GetItemTypes
208
209 $itemtypes = &GetItemTypes( style => $style );
210
211Returns information about existing itemtypes.
212
213Params:
214 style: either 'array' or 'hash', defaults to 'hash'.
215 'array' returns an arrayref,
216 'hash' return a hashref with the itemtype value as the key
217
218build a HTML select with the following code :
219
220=head3 in PERL SCRIPT
221
222 my $itemtypes = GetItemTypes;
223 my @itemtypesloop;
224 foreach my $thisitemtype (sort keys %$itemtypes) {
225 my $selected = 1 if $thisitemtype eq $itemtype;
226 my %row =(value => $thisitemtype,
227 selected => $selected,
228 description => $itemtypes->{$thisitemtype}->{'description'},
229 );
230 push @itemtypesloop, \%row;
231 }
232 $template->param(itemtypeloop => \@itemtypesloop);
233
234=head3 in TEMPLATE
235
236 <form action='<!-- TMPL_VAR name="script_name" -->' method=post>
237 <select name="itemtype">
238 <option value="">Default</option>
239 <!-- TMPL_LOOP name="itemtypeloop" -->
240 <option value="<!-- TMPL_VAR name="value" -->" <!-- TMPL_IF name="selected" -->selected<!-- /TMPL_IF -->><!-- TMPL_VAR name="description" --></option>
241 <!-- /TMPL_LOOP -->
242 </select>
243 <input type=text name=searchfield value="<!-- TMPL_VAR name="searchfield" -->">
244 <input type="submit" value="OK" class="button">
245 </form>
246
247=cut
248
249sub GetItemTypes {
250 my ( %params ) = @_;
251 my $style = defined( $params{'style'} ) ? $params{'style'} : 'hash';
252
253 # returns a reference to a hash of references to itemtypes...
254 my %itemtypes;
255 my $dbh = C4::Context->dbh;
256 my $query = qq|
257 SELECT *
258 FROM itemtypes
259 |;
260 my $sth = $dbh->prepare($query);
261 $sth->execute;
262
263 if ( $style eq 'hash' ) {
264 while ( my $IT = $sth->fetchrow_hashref ) {
265 $itemtypes{ $IT->{'itemtype'} } = $IT;
266 }
267 return ( \%itemtypes );
268 } else {
269 return $sth->fetchall_arrayref({});
270 }
271}
272
273sub get_itemtypeinfos_of {
274 my @itemtypes = @_;
275
276 my $placeholders = join( ', ', map { '?' } @itemtypes );
277 my $query = <<"END_SQL";
278SELECT itemtype,
279 description,
280 imageurl,
281 notforloan
282 FROM itemtypes
283 WHERE itemtype IN ( $placeholders )
284END_SQL
285
286 return get_infos_of( $query, 'itemtype', undef, \@itemtypes );
287}
288
289=head2 getauthtypes
290
291 $authtypes = &getauthtypes();
292
293Returns information about existing authtypes.
294
295build a HTML select with the following code :
296
297=head3 in PERL SCRIPT
298
299 my $authtypes = getauthtypes;
300 my @authtypesloop;
301 foreach my $thisauthtype (keys %$authtypes) {
302 my $selected = 1 if $thisauthtype eq $authtype;
303 my %row =(value => $thisauthtype,
304 selected => $selected,
305 authtypetext => $authtypes->{$thisauthtype}->{'authtypetext'},
306 );
307 push @authtypesloop, \%row;
308 }
309 $template->param(itemtypeloop => \@itemtypesloop);
310
311=head3 in TEMPLATE
312
313 <form action='<!-- TMPL_VAR name="script_name" -->' method=post>
314 <select name="authtype">
315 <!-- TMPL_LOOP name="authtypeloop" -->
316 <option value="<!-- TMPL_VAR name="value" -->" <!-- TMPL_IF name="selected" -->selected<!-- /TMPL_IF -->><!-- TMPL_VAR name="authtypetext" --></option>
317 <!-- /TMPL_LOOP -->
318 </select>
319 <input type=text name=searchfield value="<!-- TMPL_VAR name="searchfield" -->">
320 <input type="submit" value="OK" class="button">
321 </form>
322
323
324=cut
325
326sub getauthtypes {
327
328 # returns a reference to a hash of references to authtypes...
329 my %authtypes;
330 my $dbh = C4::Context->dbh;
331 my $sth = $dbh->prepare("select * from auth_types order by authtypetext");
332 $sth->execute;
333 while ( my $IT = $sth->fetchrow_hashref ) {
334 $authtypes{ $IT->{'authtypecode'} } = $IT;
335 }
336 return ( \%authtypes );
337}
338
339sub getauthtype {
340 my ($authtypecode) = @_;
341
342 # returns a reference to a hash of references to authtypes...
343 my %authtypes;
344 my $dbh = C4::Context->dbh;
345 my $sth = $dbh->prepare("select * from auth_types where authtypecode=?");
346 $sth->execute($authtypecode);
347 my $res = $sth->fetchrow_hashref;
348 return $res;
349}
350
351=head2 getframework
352
353 $frameworks = &getframework();
354
355Returns information about existing frameworks
356
357build a HTML select with the following code :
358
359=head3 in PERL SCRIPT
360
361 my $frameworks = frameworks();
362 my @frameworkloop;
363 foreach my $thisframework (keys %$frameworks) {
364 my $selected = 1 if $thisframework eq $frameworkcode;
365 my %row =(value => $thisframework,
366 selected => $selected,
367 description => $frameworks->{$thisframework}->{'frameworktext'},
368 );
369 push @frameworksloop, \%row;
370 }
371 $template->param(frameworkloop => \@frameworksloop);
372
373=head3 in TEMPLATE
374
375 <form action='<!-- TMPL_VAR name="script_name" -->' method=post>
376 <select name="frameworkcode">
377 <option value="">Default</option>
378 <!-- TMPL_LOOP name="frameworkloop" -->
379 <option value="<!-- TMPL_VAR name="value" -->" <!-- TMPL_IF name="selected" -->selected<!-- /TMPL_IF -->><!-- TMPL_VAR name="frameworktext" --></option>
380 <!-- /TMPL_LOOP -->
381 </select>
382 <input type=text name=searchfield value="<!-- TMPL_VAR name="searchfield" -->">
383 <input type="submit" value="OK" class="button">
384 </form>
385
386=cut
387
388sub getframeworks {
389
390 # returns a reference to a hash of references to branches...
391 my %itemtypes;
392 my $dbh = C4::Context->dbh;
393 my $sth = $dbh->prepare("select * from biblio_framework");
394 $sth->execute;
395 while ( my $IT = $sth->fetchrow_hashref ) {
396 $itemtypes{ $IT->{'frameworkcode'} } = $IT;
397 }
398 return ( \%itemtypes );
399}
400
401=head2 getframeworkinfo
402
403 $frameworkinfo = &getframeworkinfo($frameworkcode);
404
405Returns information about an frameworkcode.
406
407=cut
408
409sub getframeworkinfo {
410 my ($frameworkcode) = @_;
411 my $dbh = C4::Context->dbh;
412 my $sth =
413 $dbh->prepare("select * from biblio_framework where frameworkcode=?");
414 $sth->execute($frameworkcode);
415 my $res = $sth->fetchrow_hashref;
416 return $res;
417}
418
419=head2 getitemtypeinfo
420
421 $itemtype = &getitemtypeinfo($itemtype, [$interface]);
422
423Returns information about an itemtype. The optional $interface argument
424sets which interface ('opac' or 'intranet') to return the imageurl for.
425Defaults to intranet.
426
427=cut
428
429sub getitemtypeinfo {
430 my ($itemtype, $interface) = @_;
431 my $dbh = C4::Context->dbh;
432 my $sth = $dbh->prepare("select * from itemtypes where itemtype=?");
433 $sth->execute($itemtype);
434 my $res = $sth->fetchrow_hashref;
435
436 $res->{imageurl} = getitemtypeimagelocation( ( ( defined $interface && $interface eq 'opac' ) ? 'opac' : 'intranet' ), $res->{imageurl} );
437
438 return $res;
439}
440
441=head2 getitemtypeimagedir
442
443 my $directory = getitemtypeimagedir( 'opac' );
444
445pass in 'opac' or 'intranet'. Defaults to 'opac'.
446
447returns the full path to the appropriate directory containing images.
448
449=cut
450
451sub getitemtypeimagedir {
452 my $src = shift || 'opac';
453 if ($src eq 'intranet') {
454 return C4::Context->config('intrahtdocs') . '/' .C4::Context->preference('template') . '/img/itemtypeimg';
455 } else {
456 return C4::Context->config('opachtdocs') . '/' . C4::Context->preference('opacthemes') . '/itemtypeimg';
457 }
458}
459
460sub getitemtypeimagesrc {
461 my $src = shift || 'opac';
462 if ($src eq 'intranet') {
463 return '/intranet-tmpl' . '/' . C4::Context->preference('template') . '/img/itemtypeimg';
464 } else {
465 return '/opac-tmpl' . '/' . C4::Context->preference('opacthemes') . '/itemtypeimg';
466 }
467}
468
469sub getitemtypeimagelocation {
470 my ( $src, $image ) = @_;
471
472 return '' if ( !$image );
473 require URI::Split;
474
475 my $scheme = ( URI::Split::uri_split( $image ) )[0];
476
477 return $image if ( $scheme );
478
479 return getitemtypeimagesrc( $src ) . '/' . $image;
480}
481
482=head3 _getImagesFromDirectory
483
484Find all of the image files in a directory in the filesystem
485
486parameters: a directory name
487
488returns: a list of images in that directory.
489
490Notes: this does not traverse into subdirectories. See
491_getSubdirectoryNames for help with that.
492Images are assumed to be files with .gif or .png file extensions.
493The image names returned do not have the directory name on them.
494
495=cut
496
497sub _getImagesFromDirectory {
498 my $directoryname = shift;
499 return unless defined $directoryname;
500 return unless -d $directoryname;
501
502 if ( opendir ( my $dh, $directoryname ) ) {
503 my @images = grep { /\.(gif|png)$/i } readdir( $dh );
504 closedir $dh;
505 @images = sort(@images);
506 return @images;
507 } else {
508 warn "unable to opendir $directoryname: $!";
509 return;
510 }
511}
512
513=head3 _getSubdirectoryNames
514
515Find all of the directories in a directory in the filesystem
516
517parameters: a directory name
518
519returns: a list of subdirectories in that directory.
520
521Notes: this does not traverse into subdirectories. Only the first
522level of subdirectories are returned.
523The directory names returned don't have the parent directory name on them.
524
525=cut
526
527sub _getSubdirectoryNames {
528 my $directoryname = shift;
529 return unless defined $directoryname;
530 return unless -d $directoryname;
531
532 if ( opendir ( my $dh, $directoryname ) ) {
533 my @directories = grep { -d File::Spec->catfile( $directoryname, $_ ) && ! ( /^\./ ) } readdir( $dh );
534 closedir $dh;
535 return @directories;
536 } else {
537 warn "unable to opendir $directoryname: $!";
538 return;
539 }
540}
541
542=head3 getImageSets
543
544returns: a listref of hashrefs. Each hash represents another collection of images.
545
546 { imagesetname => 'npl', # the name of the image set (npl is the original one)
547 images => listref of image hashrefs
548 }
549
550each image is represented by a hashref like this:
551
552 { KohaImage => 'npl/image.gif',
553 StaffImageUrl => '/intranet-tmpl/prog/img/itemtypeimg/npl/image.gif',
554 OpacImageURL => '/opac-tmpl/prog/itemtypeimg/npl/image.gif'
555 checked => 0 or 1: was this the image passed to this method?
556 Note: I'd like to remove this somehow.
557 }
558
559=cut
560
561sub getImageSets {
562 my %params = @_;
563 my $checked = $params{'checked'} || '';
564
565 my $paths = { staff => { filesystem => getitemtypeimagedir('intranet'),
566 url => getitemtypeimagesrc('intranet'),
567 },
568 opac => { filesystem => getitemtypeimagedir('opac'),
569 url => getitemtypeimagesrc('opac'),
570 }
571 };
572
573 my @imagesets = (); # list of hasrefs of image set data to pass to template
574 my @subdirectories = _getSubdirectoryNames( $paths->{'staff'}{'filesystem'} );
575 foreach my $imagesubdir ( @subdirectories ) {
576 warn $imagesubdir if $DEBUG;
577 my @imagelist = (); # hashrefs of image info
578 my @imagenames = _getImagesFromDirectory( File::Spec->catfile( $paths->{'staff'}{'filesystem'}, $imagesubdir ) );
579 my $imagesetactive = 0;
580 foreach my $thisimage ( @imagenames ) {
581 push( @imagelist,
582 { KohaImage => "$imagesubdir/$thisimage",
583 StaffImageUrl => join( '/', $paths->{'staff'}{'url'}, $imagesubdir, $thisimage ),
584 OpacImageUrl => join( '/', $paths->{'opac'}{'url'}, $imagesubdir, $thisimage ),
585 checked => "$imagesubdir/$thisimage" eq $checked ? 1 : 0,
586 }
587 );
588 $imagesetactive = 1 if "$imagesubdir/$thisimage" eq $checked;
589 }
590 push @imagesets, { imagesetname => $imagesubdir,
591 imagesetactive => $imagesetactive,
592 images => \@imagelist };
593
594 }
595 return \@imagesets;
596}
597
598=head2 GetPrinters
599
600 $printers = &GetPrinters();
601 @queues = keys %$printers;
602
603Returns information about existing printer queues.
604
605C<$printers> is a reference-to-hash whose keys are the print queues
606defined in the printers table of the Koha database. The values are
607references-to-hash, whose keys are the fields in the printers table.
608
609=cut
610
611sub GetPrinters {
612 my %printers;
613 my $dbh = C4::Context->dbh;
614 my $sth = $dbh->prepare("select * from printers");
615 $sth->execute;
616 while ( my $printer = $sth->fetchrow_hashref ) {
617 $printers{ $printer->{'printqueue'} } = $printer;
618 }
619 return ( \%printers );
620}
621
622=head2 GetPrinter
623
624 $printer = GetPrinter( $query, $printers );
625
626=cut
627
628sub GetPrinter {
629 my ( $query, $printers ) = @_; # get printer for this query from printers
630 my $printer = $query->param('printer');
631 my %cookie = $query->cookie('userenv');
632 ($printer) || ( $printer = $cookie{'printer'} ) || ( $printer = '' );
633 ( $printers->{$printer} ) || ( $printer = ( keys %$printers )[0] );
634 return $printer;
635}
636
637=head2 getnbpages
638
639Returns the number of pages to display in a pagination bar, given the number
640of items and the number of items per page.
641
642=cut
643
644sub getnbpages {
645 my ( $nb_items, $nb_items_per_page ) = @_;
646
647 return int( ( $nb_items - 1 ) / $nb_items_per_page ) + 1;
648}
649
650=head2 getallthemes
651
652 (@themes) = &getallthemes('opac');
653 (@themes) = &getallthemes('intranet');
654
655Returns an array of all available themes.
656
657=cut
658
659sub getallthemes {
660 my $type = shift;
661 my $htdocs;
662 my @themes;
663 if ( $type eq 'intranet' ) {
664 $htdocs = C4::Context->config('intrahtdocs');
665 }
666 else {
667 $htdocs = C4::Context->config('opachtdocs');
668 }
669 opendir D, "$htdocs";
670 my @dirlist = readdir D;
671 foreach my $directory (@dirlist) {
672 next if $directory eq 'lib';
673 -d "$htdocs/$directory/en" and push @themes, $directory;
674 }
675 return @themes;
676}
677
678sub getFacets {
679 my $facets;
680 if ( C4::Context->preference("marcflavour") eq "UNIMARC" ) {
681 $facets = [
682 {
683 idx => 'su-to',
684 label => 'Topics',
685 tags => [ qw/ 600ab 601ab 602a 604at 605a 606ax 610a / ],
686 sep => ' - ',
687 },
688 {
689 idx => 'su-geo',
690 label => 'Places',
691 tags => [ qw/ 607a / ],
692 sep => ' - ',
693 },
694 {
695 idx => 'su-ut',
696 label => 'Titles',
697 tags => [ qw/ 500a 501a 503a / ],
698 sep => ', ',
699 },
700 {
701 idx => 'au',
702 label => 'Authors',
703 tags => [ qw/ 700ab 701ab 702ab / ],
704 sep => C4::Context->preference("UNIMARCAuthorsFacetsSeparator"),
705 },
706 {
707 idx => 'se',
708 label => 'Series',
709 tags => [ qw/ 225a / ],
710 sep => ', ',
711 },
712 {
713 idx => 'location',
714 label => 'Location',
715 tags => [ qw/ 995c / ],
716 }
717 ];
718
719 my $library_facet;
720 unless ( C4::Context->preference("singleBranchMode") || GetBranchesCount() == 1 ) {
721 $library_facet = {
722 idx => 'branch',
723 label => 'Libraries',
724 tags => [ qw/ 995b / ],
725 };
726 }
727 push( @$facets, $library_facet );
728 }
729 else {
730 $facets = [
731 {
732 idx => 'su-to',
733 label => 'Topics',
734 tags => [ qw/ 650a / ],
735 sep => '--',
736 },
737 # {
738 # idx => 'su-na',
739 # label => 'People and Organizations',
740 # tags => [ qw/ 600a 610a 611a / ],
741 # sep => 'a',
742 # },
743 {
744 idx => 'su-geo',
745 label => 'Places',
746 tags => [ qw/ 651a / ],
747 sep => '--',
748 },
749 {
750 idx => 'su-ut',
751 label => 'Titles',
752 tags => [ qw/ 630a / ],
753 sep => '--',
754 },
755 {
756 idx => 'au',
757 label => 'Authors',
758 tags => [ qw/ 100a 110a 700a / ],
759 sep => ', ',
760 },
761 {
762 idx => 'se',
763 label => 'Series',
764 tags => [ qw/ 440a 490a / ],
765 sep => ', ',
766 },
767 {
768 idx => 'itype',
769 label => 'ItemTypes',
770 tags => [ qw/ 952y 942c / ],
771 sep => ', ',
772 },
773 {
774 idx => 'location',
775 label => 'Location',
776 tags => [ qw / 952c / ],
777 },
778 ];
779
780 my $library_facet;
781 unless ( C4::Context->preference("singleBranchMode") || GetBranchesCount() == 1 ) {
782 $library_facet = {
783 idx => 'branch',
784 label => 'Libraries',
785 tags => [ qw / 952b / ],
786 };
787 }
788 push( @$facets, $library_facet );
789 }
790 return $facets;
791}
792
793=head2 get_infos_of
794
795Return a href where a key is associated to a href. You give a query,
796the name of the key among the fields returned by the query. If you
797also give as third argument the name of the value, the function
798returns a href of scalar. The optional 4th argument is an arrayref of
799items passed to the C<execute()> call. It is designed to bind
800parameters to any placeholders in your SQL.
801
802 my $query = '
803SELECT itemnumber,
804 notforloan,
805 barcode
806 FROM items
807';
808
809 # generic href of any information on the item, href of href.
810 my $iteminfos_of = get_infos_of($query, 'itemnumber');
811 print $iteminfos_of->{$itemnumber}{barcode};
812
813 # specific information, href of scalar
814 my $barcode_of_item = get_infos_of($query, 'itemnumber', 'barcode');
815 print $barcode_of_item->{$itemnumber};
816
817=cut
818
819sub get_infos_of {
820 my ( $query, $key_name, $value_name, $bind_params ) = @_;
821
822 my $dbh = C4::Context->dbh;
823
824 my $sth = $dbh->prepare($query);
825 $sth->execute( @$bind_params );
826
827 my %infos_of;
828 while ( my $row = $sth->fetchrow_hashref ) {
829 if ( defined $value_name ) {
830 $infos_of{ $row->{$key_name} } = $row->{$value_name};
831 }
832 else {
833 $infos_of{ $row->{$key_name} } = $row;
834 }
835 }
836 $sth->finish;
837
838 return \%infos_of;
839}
840
841=head2 get_notforloan_label_of
842
843 my $notforloan_label_of = get_notforloan_label_of();
844
845Each authorised value of notforloan (information available in items and
846itemtypes) is link to a single label.
847
848Returns a href where keys are authorised values and values are corresponding
849labels.
850
851 foreach my $authorised_value (keys %{$notforloan_label_of}) {
852 printf(
853 "authorised_value: %s => %s\n",
854 $authorised_value,
855 $notforloan_label_of->{$authorised_value}
856 );
857 }
858
859=cut
860
861# FIXME - why not use GetAuthorisedValues ??
862#
863sub get_notforloan_label_of {
864 my $dbh = C4::Context->dbh;
865
866 my $query = '
867SELECT authorised_value
868 FROM marc_subfield_structure
869 WHERE kohafield = \'items.notforloan\'
870 LIMIT 0, 1
871';
872 my $sth = $dbh->prepare($query);
873 $sth->execute();
874 my ($statuscode) = $sth->fetchrow_array();
875
876 $query = '
877SELECT lib,
878 authorised_value
879 FROM authorised_values
880 WHERE category = ?
881';
882 $sth = $dbh->prepare($query);
883 $sth->execute($statuscode);
884 my %notforloan_label_of;
885 while ( my $row = $sth->fetchrow_hashref ) {
886 $notforloan_label_of{ $row->{authorised_value} } = $row->{lib};
887 }
888 $sth->finish;
889
890 return \%notforloan_label_of;
891}
892
893=head2 displayServers
894
895 my $servers = displayServers();
896 my $servers = displayServers( $position );
897 my $servers = displayServers( $position, $type );
898
899displayServers returns a listref of hashrefs, each containing
900information about available z3950 servers. Each hashref has a format
901like:
902
903 {
904 'checked' => 'checked',
905 'encoding' => 'utf8',
906 'icon' => undef,
907 'id' => 'LIBRARY OF CONGRESS',
908 'label' => '',
909 'name' => 'server',
910 'opensearch' => '',
911 'value' => 'lx2.loc.gov:210/',
912 'zed' => 1,
913 },
914
915=cut
916
917sub displayServers {
918 my ( $position, $type ) = @_;
919 my $dbh = C4::Context->dbh;
920
921 my $strsth = 'SELECT * FROM z3950servers';
922 my @where_clauses;
923 my @bind_params;
924
925 if ($position) {
926 push @bind_params, $position;
927 push @where_clauses, ' position = ? ';
928 }
929
930 if ($type) {
931 push @bind_params, $type;
932 push @where_clauses, ' type = ? ';
933 }
934
935 # reassemble where clause from where clause pieces
936 if (@where_clauses) {
937 $strsth .= ' WHERE ' . join( ' AND ', @where_clauses );
938 }
939
940 my $rq = $dbh->prepare($strsth);
941 $rq->execute(@bind_params);
942 my @primaryserverloop;
943
944 while ( my $data = $rq->fetchrow_hashref ) {
945 push @primaryserverloop,
946 { label => $data->{description},
947 id => $data->{name},
948 name => "server",
949 value => $data->{host} . ":" . $data->{port} . "/" . $data->{database},
950 encoding => ( $data->{encoding} ? $data->{encoding} : "iso-5426" ),
951 checked => "checked",
952 icon => $data->{icon},
953 zed => $data->{type} eq 'zed',
954 opensearch => $data->{type} eq 'opensearch'
955 };
956 }
957 return \@primaryserverloop;
958}
959
960
961=head2 GetKohaImageurlFromAuthorisedValues
962
963$authhorised_value = GetKohaImageurlFromAuthorisedValues( $category, $authvalcode );
964
965Return the first url of the authorised value image represented by $lib.
966
967=cut
968
969sub GetKohaImageurlFromAuthorisedValues {
970 my ( $category, $lib ) = @_;
971 my $dbh = C4::Context->dbh;
972 my $sth = $dbh->prepare("SELECT imageurl FROM authorised_values WHERE category=? AND lib =?");
973 $sth->execute( $category, $lib );
974 while ( my $data = $sth->fetchrow_hashref ) {
975 return $data->{'imageurl'};
976 }
977}
978
979=head2 GetAuthValCode
980
981 $authvalcode = GetAuthValCode($kohafield,$frameworkcode);
982
983=cut
984
985sub GetAuthValCode {
986 my ($kohafield,$fwcode) = @_;
987 my $dbh = C4::Context->dbh;
988 $fwcode='' unless $fwcode;
989 my $sth = $dbh->prepare('select authorised_value from marc_subfield_structure where kohafield=? and frameworkcode=?');
990 $sth->execute($kohafield,$fwcode);
991 my ($authvalcode) = $sth->fetchrow_array;
992 return $authvalcode;
993}
994
995=head2 GetAuthValCodeFromField
996
997 $authvalcode = GetAuthValCodeFromField($field,$subfield,$frameworkcode);
998
999C<$subfield> can be undefined
1000
1001=cut
1002
1003sub GetAuthValCodeFromField {
1004 my ($field,$subfield,$fwcode) = @_;
1005 my $dbh = C4::Context->dbh;
1006 $fwcode='' unless $fwcode;
1007 my $sth;
1008 if (defined $subfield) {
1009 $sth = $dbh->prepare('select authorised_value from marc_subfield_structure where tagfield=? and tagsubfield=? and frameworkcode=?');
1010 $sth->execute($field,$subfield,$fwcode);
1011 } else {
1012 $sth = $dbh->prepare('select authorised_value from marc_tag_structure where tagfield=? and frameworkcode=?');
1013 $sth->execute($field,$fwcode);
1014 }
1015 my ($authvalcode) = $sth->fetchrow_array;
1016 return $authvalcode;
1017}
1018
1019=head2 GetAuthorisedValues
1020
1021 $authvalues = GetAuthorisedValues([$category], [$selected]);
1022
1023This function returns all authorised values from the'authorised_value' table in a reference to array of hashrefs.
1024
1025C<$category> returns authorised values for just one category (optional).
1026
1027C<$opac> If set to a true value, displays OPAC descriptions rather than normal ones when they exist.
1028
1029=cut
1030
1031sub GetAuthorisedValues {
1032 my ( $category, $selected, $opac ) = @_;
1033 my $branch_limit = C4::Context->userenv ? C4::Context->userenv->{"branch"} : "";
1034 my @results;
1035 my $dbh = C4::Context->dbh;
1036 my $query = qq{
1037 SELECT *
1038 FROM authorised_values
1039 };
1040 $query .= qq{
1041 LEFT JOIN authorised_values_branches ON ( id = av_id )
1042 } if $branch_limit;
1043 my @where_strings;
1044 my @where_args;
1045 if($category) {
1046 push @where_strings, "category = ?";
1047 push @where_args, $category;
1048 }
1049 if($branch_limit) {
1050 push @where_strings, "( branchcode = ? OR branchcode IS NULL )";
1051 push @where_args, $branch_limit;
1052 }
1053 if(@where_strings > 0) {
1054 $query .= " WHERE " . join(" AND ", @where_strings);
1055 }
1056 $query .= " GROUP BY lib";
1057 $query .= ' ORDER BY category, ' . (
1058 $opac ? 'COALESCE(lib_opac, lib)'
1059 : 'lib, lib_opac'
1060 );
1061
1062 my $sth = $dbh->prepare($query);
1063
1064 $sth->execute( @where_args );
1065 while (my $data=$sth->fetchrow_hashref) {
1066 if ( defined $selected and $selected eq $data->{authorised_value} ) {
1067 $data->{selected} = 1;
1068 }
1069 else {
1070 $data->{selected} = 0;
1071 }
1072
1073 if ($opac && $data->{lib_opac}) {
1074 $data->{lib} = $data->{lib_opac};
1075 }
1076 push @results, $data;
1077 }
1078 $sth->finish;
1079 return \@results;
1080}
1081
1082=head2 GetAuthorisedValueCategories
1083
1084 $auth_categories = GetAuthorisedValueCategories();
1085
1086Return an arrayref of all of the available authorised
1087value categories.
1088
1089=cut
1090
1091sub GetAuthorisedValueCategories {
1092 my $dbh = C4::Context->dbh;
1093 my $sth = $dbh->prepare("SELECT DISTINCT category FROM authorised_values ORDER BY category");
1094 $sth->execute;
1095 my @results;
1096 while (defined (my $category = $sth->fetchrow_array) ) {
1097 push @results, $category;
1098 }
1099 return \@results;
1100}
1101
1102=head2 IsAuthorisedValueCategory
1103
1104 $is_auth_val_category = IsAuthorisedValueCategory($category);
1105
1106Returns whether a given category name is a valid one
1107
1108=cut
1109
1110sub IsAuthorisedValueCategory {
1111 my $category = shift;
1112 my $query = '
1113 SELECT category
1114 FROM authorised_values
1115 WHERE BINARY category=?
1116 LIMIT 1
1117 ';
1118 my $sth = C4::Context->dbh->prepare($query);
1119 $sth->execute($category);
1120 $sth->fetchrow ? return 1
1121 : return 0;
1122}
1123
1124=head2 GetAuthorisedValueByCode
1125
1126$authorised_value = GetAuthorisedValueByCode( $category, $authvalcode, $opac );
1127
1128Return the lib attribute from authorised_values from the row identified
1129by the passed category and code
1130
1131=cut
1132
1133sub GetAuthorisedValueByCode {
1134 my ( $category, $authvalcode, $opac ) = @_;
1135
1136 my $field = $opac ? 'lib_opac' : 'lib';
1137 my $dbh = C4::Context->dbh;
1138 my $sth = $dbh->prepare("SELECT $field FROM authorised_values WHERE category=? AND authorised_value =?");
1139 $sth->execute( $category, $authvalcode );
1140 while ( my $data = $sth->fetchrow_hashref ) {
1141 return $data->{ $field };
1142 }
1143}
1144
1145=head2 GetKohaAuthorisedValues
1146
1147Takes $kohafield, $fwcode as parameters.
1148
1149If $opac parameter is set to a true value, displays OPAC descriptions rather than normal ones when they exist.
1150
1151Returns hashref of Code => description
1152
1153Returns undef if no authorised value category is defined for the kohafield.
1154
1155=cut
1156
1157sub GetKohaAuthorisedValues {
1158 my ($kohafield,$fwcode,$opac) = @_;
1159 $fwcode='' unless $fwcode;
1160 my %values;
1161 my $dbh = C4::Context->dbh;
1162 my $avcode = GetAuthValCode($kohafield,$fwcode);
1163 if ($avcode) {
1164 my $sth = $dbh->prepare("select authorised_value, lib, lib_opac from authorised_values where category=? ");
1165 $sth->execute($avcode);
1166 while ( my ($val, $lib, $lib_opac) = $sth->fetchrow_array ) {
1167 $values{$val} = ($opac && $lib_opac) ? $lib_opac : $lib;
1168 }
1169 return \%values;
1170 } else {
1171 return;
1172 }
1173}
1174
1175=head2 GetKohaAuthorisedValuesFromField
1176
1177Takes $field, $subfield, $fwcode as parameters.
1178
1179If $opac parameter is set to a true value, displays OPAC descriptions rather than normal ones when they exist.
1180$subfield can be undefined
1181
1182Returns hashref of Code => description
1183
1184Returns undef if no authorised value category is defined for the given field and subfield
1185
1186=cut
1187
1188sub GetKohaAuthorisedValuesFromField {
1189 my ($field, $subfield, $fwcode,$opac) = @_;
1190 $fwcode='' unless $fwcode;
1191 my %values;
1192 my $dbh = C4::Context->dbh;
1193 my $avcode = GetAuthValCodeFromField($field, $subfield, $fwcode);
1194 if ($avcode) {
1195 my $sth = $dbh->prepare("select authorised_value, lib, lib_opac from authorised_values where category=? ");
1196 $sth->execute($avcode);
1197 while ( my ($val, $lib, $lib_opac) = $sth->fetchrow_array ) {
1198 $values{$val} = ($opac && $lib_opac) ? $lib_opac : $lib;
1199 }
1200 return \%values;
1201 } else {
1202 return;
1203 }
1204}
1205
1206=head2 xml_escape
1207
1208 my $escaped_string = C4::Koha::xml_escape($string);
1209
1210Convert &, <, >, ', and " in a string to XML entities
1211
1212=cut
1213
1214sub xml_escape {
1215 my $str = shift;
1216 return '' unless defined $str;
1217 $str =~ s/&/&amp;/g;
1218 $str =~ s/</&lt;/g;
1219 $str =~ s/>/&gt;/g;
1220 $str =~ s/'/&apos;/g;
1221 $str =~ s/"/&quot;/g;
1222 return $str;
1223}
1224
1225=head2 GetKohaAuthorisedValueLib
1226
1227Takes $category, $authorised_value as parameters.
1228
1229If $opac parameter is set to a true value, displays OPAC descriptions rather than normal ones when they exist.
1230
1231Returns authorised value description
1232
1233=cut
1234
1235sub GetKohaAuthorisedValueLib {
1236 my ($category,$authorised_value,$opac) = @_;
1237 my $value;
1238 my $dbh = C4::Context->dbh;
1239 my $sth = $dbh->prepare("select lib, lib_opac from authorised_values where category=? and authorised_value=?");
1240 $sth->execute($category,$authorised_value);
1241 my $data = $sth->fetchrow_hashref;
1242 $value = ($opac && $$data{'lib_opac'}) ? $$data{'lib_opac'} : $$data{'lib'};
1243 return $value;
1244}
1245
1246=head2 AddAuthorisedValue
1247
1248 AddAuthorisedValue($category, $authorised_value, $lib, $lib_opac, $imageurl);
1249
1250Create a new authorised value.
1251
1252=cut
1253
1254sub AddAuthorisedValue {
1255 my ($category, $authorised_value, $lib, $lib_opac, $imageurl) = @_;
1256
1257 my $dbh = C4::Context->dbh;
1258 my $query = qq{
1259 INSERT INTO authorised_values (category, authorised_value, lib, lib_opac, imageurl)
1260 VALUES (?,?,?,?,?)
1261 };
1262 my $sth = $dbh->prepare($query);
1263 $sth->execute($category, $authorised_value, $lib, $lib_opac, $imageurl);
1264}
1265
1266=head2 display_marc_indicators
1267
1268 my $display_form = C4::Koha::display_marc_indicators($field);
1269
1270C<$field> is a MARC::Field object
1271
1272Generate a display form of the indicators of a variable
1273MARC field, replacing any blanks with '#'.
1274
1275=cut
1276
1277sub display_marc_indicators {
1278 my $field = shift;
1279 my $indicators = '';
1280 if ($field->tag() >= 10) {
1281 $indicators = $field->indicator(1) . $field->indicator(2);
1282 $indicators =~ s/ /#/g;
1283 }
1284 return $indicators;
1285}
1286
1287sub GetNormalizedUPC {
1288 my ($record,$marcflavour) = @_;
1289 my (@fields,$upc);
1290
1291 if ($marcflavour eq 'UNIMARC') {
1292 @fields = $record->field('072');
1293 foreach my $field (@fields) {
1294 my $upc = _normalize_match_point($field->subfield('a'));
1295 if ($upc ne '') {
1296 return $upc;
1297 }
1298 }
1299
1300 }
1301 else { # assume marc21 if not unimarc
1302 @fields = $record->field('024');
1303 foreach my $field (@fields) {
1304 my $indicator = $field->indicator(1);
1305 my $upc = _normalize_match_point($field->subfield('a'));
1306 if ($indicator == 1 and $upc ne '') {
1307 return $upc;
1308 }
1309 }
1310 }
1311}
1312
1313# Normalizes and returns the first valid ISBN found in the record
1314# ISBN13 are converted into ISBN10. This is required to get some book cover images.
1315sub GetNormalizedISBN {
1316 my ($isbn,$record,$marcflavour) = @_;
1317 my @fields;
1318 if ($isbn) {
1319 # Koha attempts to store multiple ISBNs in biblioitems.isbn, separated by " | "
1320 # anything after " | " should be removed, along with the delimiter
1321 $isbn =~ s/(.*)( \| )(.*)/$1/;
1322 return _isbn_cleanup($isbn);
1323 }
1324 return unless $record;
1325
1326 if ($marcflavour eq 'UNIMARC') {
1327 @fields = $record->field('010');
1328 foreach my $field (@fields) {
1329 my $isbn = $field->subfield('a');
1330 if ($isbn) {
1331 return _isbn_cleanup($isbn);
1332 } else {
1333 return;
1334 }
1335 }
1336 }
1337 else { # assume marc21 if not unimarc
1338 @fields = $record->field('020');
1339 foreach my $field (@fields) {
1340 $isbn = $field->subfield('a');
1341 if ($isbn) {
1342 return _isbn_cleanup($isbn);
1343 } else {
1344 return;
1345 }
1346 }
1347 }
1348}
1349
1350sub GetNormalizedEAN {
1351 my ($record,$marcflavour) = @_;
1352 my (@fields,$ean);
1353
1354 if ($marcflavour eq 'UNIMARC') {
1355 @fields = $record->field('073');
1356 foreach my $field (@fields) {
1357 $ean = _normalize_match_point($field->subfield('a'));
1358 if ($ean ne '') {
1359 return $ean;
1360 }
1361 }
1362 }
1363 else { # assume marc21 if not unimarc
1364 @fields = $record->field('024');
1365 foreach my $field (@fields) {
1366 my $indicator = $field->indicator(1);
1367 $ean = _normalize_match_point($field->subfield('a'));
1368 if ($indicator == 3 and $ean ne '') {
1369 return $ean;
1370 }
1371 }
1372 }
1373}
1374sub GetNormalizedOCLCNumber {
1375 my ($record,$marcflavour) = @_;
1376 my (@fields,$oclc);
1377
1378 if ($marcflavour eq 'UNIMARC') {
1379 # TODO: add UNIMARC fields
1380 }
1381 else { # assume marc21 if not unimarc
1382 @fields = $record->field('035');
1383 foreach my $field (@fields) {
1384 $oclc = $field->subfield('a');
1385 if ($oclc =~ /OCoLC/) {
1386 $oclc =~ s/\(OCoLC\)//;
1387 return $oclc;
1388 } else {
1389 return;
1390 }
1391 }
1392 }
1393}
1394
1395=head2 GetDailyQuote($opts)
1396
1397Takes a hashref of options
1398
1399Currently supported options are:
1400
1401'id' An exact quote id
1402'random' Select a random quote
1403noop When no option is passed in, this sub will return the quote timestamped for the current day
1404
1405The function returns an anonymous hash following this format:
1406
1407 {
1408 'source' => 'source-of-quote',
1409 'timestamp' => 'timestamp-value',
1410 'text' => 'text-of-quote',
1411 'id' => 'quote-id'
1412 };
1413
1414=cut
1415
1416# This is definitely a candidate for some sort of caching once we finally settle caching/persistence issues...
1417# at least for default option
1418
1419sub GetDailyQuote {
1420 my %opts = @_;
1421 my $dbh = C4::Context->dbh;
1422 my $query = '';
1423 my $sth = undef;
1424 my $quote = undef;
1425 if ($opts{'id'}) {
1426 $query = 'SELECT * FROM quotes WHERE id = ?';
1427 $sth = $dbh->prepare($query);
1428 $sth->execute($opts{'id'});
1429 $quote = $sth->fetchrow_hashref();
1430 }
1431 elsif ($opts{'random'}) {
1432 # Fall through... we also return a random quote as a catch-all if all else fails
1433 }
1434 else {
1435 $query = 'SELECT * FROM quotes WHERE timestamp LIKE CONCAT(CURRENT_DATE,\'%\') ORDER BY timestamp DESC LIMIT 0,1';
1436 $sth = $dbh->prepare($query);
1437 $sth->execute();
1438 $quote = $sth->fetchrow_hashref();
1439 }
1440 unless ($quote) { # if there are not matches, choose a random quote
1441 # get a list of all available quote ids
1442 $sth = C4::Context->dbh->prepare('SELECT count(*) FROM quotes;');
1443 $sth->execute;
1444 my $range = ($sth->fetchrow_array)[0];
1445 # chose a random id within that range if there is more than one quote
1446 my $offset = int(rand($range));
1447 # grab it
1448 $query = 'SELECT * FROM quotes ORDER BY id LIMIT 1 OFFSET ?';
1449 $sth = C4::Context->dbh->prepare($query);
1450 # see http://www.perlmonks.org/?node_id=837422 for why
1451 # we're being verbose and using bind_param
1452 $sth->bind_param(1, $offset, SQL_INTEGER);
1453 $sth->execute();
1454 $quote = $sth->fetchrow_hashref();
1455 # update the timestamp for that quote
1456 $query = 'UPDATE quotes SET timestamp = ? WHERE id = ?';
1457 $sth = C4::Context->dbh->prepare($query);
1458 $sth->execute(
1459 DateTime::Format::MySQL->format_datetime( dt_from_string() ),
1460 $quote->{'id'}
1461 );
1462 }
1463 return $quote;
1464}
1465
1466sub _normalize_match_point {
1467 my $match_point = shift;
1468 (my $normalized_match_point) = $match_point =~ /([\d-]*[X]*)/;
1469 $normalized_match_point =~ s/-//g;
1470
1471 return $normalized_match_point;
1472}
1473
1474sub _isbn_cleanup {
1475 require Business::ISBN;
1476 my $isbn = Business::ISBN->new( $_[0] );
1477 if ( $isbn ) {
1478 $isbn = $isbn->as_isbn10 if $isbn->type eq 'ISBN13';
1479 if (defined $isbn) {
1480 return $isbn->as_string([]);
1481 }
1482 }
1483 return;
1484}
1485
148612µs1;
1487
1488__END__
Report produced by the NYTProf 5.06 Perl profiler, developed by Tim Bunce and Adam Kaplan.