File: | C4/Koha.pm |
Coverage: | 7.8% |
line | stmt | bran | cond | sub | time | code |
---|---|---|---|---|---|---|
1 | package 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 | ||||||
23 | 44 44 44 | 439121 324 1763 | use strict; | |||
24 | #use warnings; FIXME - Bug 2505 | |||||
25 | 44 44 44 | 1736 310 785 | use C4::Context; | |||
26 | 44 44 44 | 30266 121344 3939 | use Memoize; | |||
27 | ||||||
28 | 44 44 44 | 541 309 6772 | use vars qw($VERSION @ISA @EXPORT $DEBUG); | |||
29 | ||||||
30 | BEGIN { | |||||
31 | 44 | 346 | $VERSION = 3.01; | |||
32 | 44 | 399 | require Exporter; | |||
33 | 44 | 683 | @ISA = qw(Exporter); | |||
34 | 44 | 791 | @EXPORT = qw( | |||
35 | &slashifyDate | |||||
36 | &subfield_is_koha_internal_p | |||||
37 | &GetPrinters &GetPrinter | |||||
38 | &GetItemTypes &getitemtypeinfo | |||||
39 | &GetCcodes | |||||
40 | &GetSupportName &GetSupportList | |||||
41 | &get_itemtypeinfos_of | |||||
42 | &getframeworks &getframeworkinfo | |||||
43 | &getauthtypes &getauthtype | |||||
44 | &getallthemes | |||||
45 | &getFacets | |||||
46 | &displayServers | |||||
47 | &getnbpages | |||||
48 | &get_infos_of | |||||
49 | &get_notforloan_label_of | |||||
50 | &getitemtypeimagedir | |||||
51 | &getitemtypeimagesrc | |||||
52 | &getitemtypeimagelocation | |||||
53 | &GetAuthorisedValues | |||||
54 | &GetAuthorisedValueCategories | |||||
55 | &GetKohaAuthorisedValues | |||||
56 | &GetKohaAuthorisedValuesFromField | |||||
57 | &GetKohaAuthorisedValueLib | |||||
58 | &GetAuthorisedValueByCode | |||||
59 | &GetKohaImageurlFromAuthorisedValues | |||||
60 | &GetAuthValCode | |||||
61 | &GetNormalizedUPC | |||||
62 | &GetNormalizedISBN | |||||
63 | &GetNormalizedEAN | |||||
64 | &GetNormalizedOCLCNumber | |||||
65 | &xml_escape | |||||
66 | ||||||
67 | $DEBUG | |||||
68 | ); | |||||
69 | 44 | 251000 | $DEBUG = 0; | |||
70 | } | |||||
71 | ||||||
72 | # expensive functions | |||||
73 | memoize('GetAuthorisedValues'); | |||||
74 | ||||||
75 - 89 | =head1 NAME C4::Koha - Perl Module containing convenience functions for Koha scripts =head1 SYNOPSIS use C4::Koha; =head1 DESCRIPTION Koha.pm provides many functions for Koha scripts. =head1 FUNCTIONS =cut | |||||
90 | ||||||
91 - 98 | =head2 slashifyDate $slash_date = &slashifyDate($dash_date); Takes a string of the form "DD-MM-YYYY" (or anything separated by dashes), converts it to the form "YYYY/MM/DD", and returns the result. =cut | |||||
99 | ||||||
100 | sub slashifyDate { | |||||
101 | ||||||
102 | # accepts a date of the form xx-xx-xx[xx] and returns it in the | |||||
103 | # form xx/xx/xx[xx] | |||||
104 | 2 | 2462 | my @dateOut = split( '-', shift ); | |||
105 | 2 | 318 | return ("$dateOut[2]/$dateOut[1]/$dateOut[0]"); | |||
106 | } | |||||
107 | ||||||
108 | # FIXME.. this should be moved to a MARC-specific module | |||||
109 | sub subfield_is_koha_internal_p ($) { | |||||
110 | 0 | 0 | my ($subfield) = @_; | |||
111 | ||||||
112 | # We could match on 'lib' and 'tab' (and 'mandatory', & more to come!) | |||||
113 | # But real MARC subfields are always single-character | |||||
114 | # so it really is safer just to check the length | |||||
115 | ||||||
116 | 0 | 0 | return length $subfield != 1; | |||
117 | } | |||||
118 | ||||||
119 - 125 | =head2 GetSupportName $itemtypename = &GetSupportName($codestring); Returns a string with the name of the itemtype. =cut | |||||
126 | ||||||
127 | sub GetSupportName{ | |||||
128 | 0 | 0 | my ($codestring)=@_; | |||
129 | 0 | 0 | return if (! $codestring); | |||
130 | 0 | 0 | my $resultstring; | |||
131 | 0 | 0 | my $advanced_search_types = C4::Context->preference("AdvancedSearchTypes"); | |||
132 | 0 | 0 | if (!$advanced_search_types or $advanced_search_types eq 'itemtypes') { | |||
133 | 0 | 0 | my $query = qq| | |||
134 | SELECT description | |||||
135 | FROM itemtypes | |||||
136 | WHERE itemtype=? | |||||
137 | order by description | |||||
138 | |; | |||||
139 | 0 | 0 | my $sth = C4::Context->dbh->prepare($query); | |||
140 | 0 | 0 | $sth->execute($codestring); | |||
141 | 0 | 0 | ($resultstring)=$sth->fetchrow; | |||
142 | 0 | 0 | return $resultstring; | |||
143 | } else { | |||||
144 | 0 | 0 | my $sth = | |||
145 | C4::Context->dbh->prepare( | |||||
146 | "SELECT lib FROM authorised_values WHERE category = ? AND authorised_value = ?" | |||||
147 | ); | |||||
148 | 0 | 0 | $sth->execute( $advanced_search_types, $codestring ); | |||
149 | 0 | 0 | my $data = $sth->fetchrow_hashref; | |||
150 | 0 | 0 | return $$data{'lib'}; | |||
151 | } | |||||
152 | ||||||
153 | } | |||||
154 - 180 | =head2 GetSupportList $itemtypes = &GetSupportList(); Returns an array ref containing informations about Support (since itemtype is rather a circulation code when item-level-itypes is used). build a HTML select with the following code : =head3 in PERL SCRIPT my $itemtypes = GetSupportList(); $template->param(itemtypeloop => $itemtypes); =head3 in TEMPLATE <form action='<!-- TMPL_VAR name="script_name" -->' method=post> <select name="itemtype"> <option value="">Default</option> <!-- TMPL_LOOP name="itemtypeloop" --> <option value="<!-- TMPL_VAR name="itemtype" -->" <!-- TMPL_IF name="selected" -->selected<!-- /TMPL_IF -->> <!--TMPL_IF Name="imageurl"--><img alt="<!-- TMPL_VAR name="description" -->" src="<!--TMPL_VAR Name="imageurl"-->><!--TMPL_ELSE-->"<!-- TMPL_VAR name="description" --><!--/TMPL_IF--></option> <!-- /TMPL_LOOP --> </select> <input type=text name=searchfield value="<!-- TMPL_VAR name="searchfield" -->"> <input type="submit" value="OK" class="button"> </form> =cut | |||||
181 | ||||||
182 | sub GetSupportList{ | |||||
183 | 0 | 0 | my $advanced_search_types = C4::Context->preference("AdvancedSearchTypes"); | |||
184 | 0 | 0 | if (!$advanced_search_types or $advanced_search_types eq 'itemtypes') { | |||
185 | 0 | 0 | my $query = qq| | |||
186 | SELECT * | |||||
187 | FROM itemtypes | |||||
188 | order by description | |||||
189 | |; | |||||
190 | 0 | 0 | my $sth = C4::Context->dbh->prepare($query); | |||
191 | 0 | 0 | $sth->execute; | |||
192 | 0 | 0 | return $sth->fetchall_arrayref({}); | |||
193 | } else { | |||||
194 | 0 | 0 | my $advsearchtypes = GetAuthorisedValues($advanced_search_types); | |||
195 | 0 0 | 0 0 | my @results= map {{itemtype=>$$_{authorised_value},description=>$$_{lib},imageurl=>$$_{imageurl}}} @$advsearchtypes; | |||
196 | 0 | 0 | return \@results; | |||
197 | } | |||||
198 | } | |||||
199 - 234 | =head2 GetItemTypes $itemtypes = &GetItemTypes(); Returns information about existing itemtypes. build a HTML select with the following code : =head3 in PERL SCRIPT my $itemtypes = GetItemTypes; my @itemtypesloop; foreach my $thisitemtype (sort keys %$itemtypes) { my $selected = 1 if $thisitemtype eq $itemtype; my %row =(value => $thisitemtype, selected => $selected, description => $itemtypes->{$thisitemtype}->{'description'}, ); push @itemtypesloop, \%row; } $template->param(itemtypeloop => \@itemtypesloop); =head3 in TEMPLATE <form action='<!-- TMPL_VAR name="script_name" -->' method=post> <select name="itemtype"> <option value="">Default</option> <!-- TMPL_LOOP name="itemtypeloop" --> <option value="<!-- TMPL_VAR name="value" -->" <!-- TMPL_IF name="selected" -->selected<!-- /TMPL_IF -->><!-- TMPL_VAR name="description" --></option> <!-- /TMPL_LOOP --> </select> <input type=text name=searchfield value="<!-- TMPL_VAR name="searchfield" -->"> <input type="submit" value="OK" class="button"> </form> =cut | |||||
235 | ||||||
236 | sub GetItemTypes { | |||||
237 | ||||||
238 | # returns a reference to a hash of references to itemtypes... | |||||
239 | 0 | 0 | my %itemtypes; | |||
240 | 0 | 0 | my $dbh = C4::Context->dbh; | |||
241 | 0 | 0 | my $query = qq| | |||
242 | SELECT * | |||||
243 | FROM itemtypes | |||||
244 | |; | |||||
245 | 0 | 0 | my $sth = $dbh->prepare($query); | |||
246 | 0 | 0 | $sth->execute; | |||
247 | 0 | 0 | while ( my $IT = $sth->fetchrow_hashref ) { | |||
248 | 0 | 0 | $itemtypes{ $IT->{'itemtype'} } = $IT; | |||
249 | } | |||||
250 | 0 | 0 | return ( \%itemtypes ); | |||
251 | } | |||||
252 | ||||||
253 | sub get_itemtypeinfos_of { | |||||
254 | 0 | 0 | my @itemtypes = @_; | |||
255 | ||||||
256 | 0 0 | 0 0 | my $placeholders = join( ', ', map { '?' } @itemtypes ); | |||
257 | 0 | 0 | my $query = <<"END_SQL"; | |||
258 | SELECT itemtype, | |||||
259 | description, | |||||
260 | imageurl, | |||||
261 | notforloan | |||||
262 | FROM itemtypes | |||||
263 | WHERE itemtype IN ( $placeholders ) | |||||
264 | END_SQL | |||||
265 | ||||||
266 | 0 | 0 | return get_infos_of( $query, 'itemtype', undef, \@itemtypes ); | |||
267 | } | |||||
268 | ||||||
269 | # this is temporary until we separate collection codes and item types | |||||
270 | sub GetCcodes { | |||||
271 | 0 | 0 | my $count = 0; | |||
272 | 0 | 0 | my @results; | |||
273 | 0 | 0 | my $dbh = C4::Context->dbh; | |||
274 | 0 | 0 | my $sth = | |||
275 | $dbh->prepare( | |||||
276 | "SELECT * FROM authorised_values ORDER BY authorised_value"); | |||||
277 | 0 | 0 | $sth->execute; | |||
278 | 0 | 0 | while ( my $data = $sth->fetchrow_hashref ) { | |||
279 | 0 | 0 | if ( $data->{category} eq "CCODE" ) { | |||
280 | 0 | 0 | $count++; | |||
281 | 0 | 0 | $results[$count] = $data; | |||
282 | ||||||
283 | #warn "data: $data"; | |||||
284 | } | |||||
285 | } | |||||
286 | 0 | 0 | $sth->finish; | |||
287 | 0 | 0 | return ( $count, @results ); | |||
288 | } | |||||
289 | ||||||
290 - 325 | =head2 getauthtypes $authtypes = &getauthtypes(); Returns information about existing authtypes. build a HTML select with the following code : =head3 in PERL SCRIPT my $authtypes = getauthtypes; my @authtypesloop; foreach my $thisauthtype (keys %$authtypes) { my $selected = 1 if $thisauthtype eq $authtype; my %row =(value => $thisauthtype, selected => $selected, authtypetext => $authtypes->{$thisauthtype}->{'authtypetext'}, ); push @authtypesloop, \%row; } $template->param(itemtypeloop => \@itemtypesloop); =head3 in TEMPLATE <form action='<!-- TMPL_VAR name="script_name" -->' method=post> <select name="authtype"> <!-- TMPL_LOOP name="authtypeloop" --> <option value="<!-- TMPL_VAR name="value" -->" <!-- TMPL_IF name="selected" -->selected<!-- /TMPL_IF -->><!-- TMPL_VAR name="authtypetext" --></option> <!-- /TMPL_LOOP --> </select> <input type=text name=searchfield value="<!-- TMPL_VAR name="searchfield" -->"> <input type="submit" value="OK" class="button"> </form> =cut | |||||
326 | ||||||
327 | sub getauthtypes { | |||||
328 | ||||||
329 | # returns a reference to a hash of references to authtypes... | |||||
330 | 0 | 0 | my %authtypes; | |||
331 | 0 | 0 | my $dbh = C4::Context->dbh; | |||
332 | 0 | 0 | my $sth = $dbh->prepare("select * from auth_types order by authtypetext"); | |||
333 | 0 | 0 | $sth->execute; | |||
334 | 0 | 0 | while ( my $IT = $sth->fetchrow_hashref ) { | |||
335 | 0 | 0 | $authtypes{ $IT->{'authtypecode'} } = $IT; | |||
336 | } | |||||
337 | 0 | 0 | return ( \%authtypes ); | |||
338 | } | |||||
339 | ||||||
340 | sub getauthtype { | |||||
341 | 0 | 0 | my ($authtypecode) = @_; | |||
342 | ||||||
343 | # returns a reference to a hash of references to authtypes... | |||||
344 | 0 | 0 | my %authtypes; | |||
345 | 0 | 0 | my $dbh = C4::Context->dbh; | |||
346 | 0 | 0 | my $sth = $dbh->prepare("select * from auth_types where authtypecode=?"); | |||
347 | 0 | 0 | $sth->execute($authtypecode); | |||
348 | 0 | 0 | my $res = $sth->fetchrow_hashref; | |||
349 | 0 | 0 | return $res; | |||
350 | } | |||||
351 | ||||||
352 - 387 | =head2 getframework $frameworks = &getframework(); Returns information about existing frameworks build a HTML select with the following code : =head3 in PERL SCRIPT my $frameworks = frameworks(); my @frameworkloop; foreach my $thisframework (keys %$frameworks) { my $selected = 1 if $thisframework eq $frameworkcode; my %row =(value => $thisframework, selected => $selected, description => $frameworks->{$thisframework}->{'frameworktext'}, ); push @frameworksloop, \%row; } $template->param(frameworkloop => \@frameworksloop); =head3 in TEMPLATE <form action='<!-- TMPL_VAR name="script_name" -->' method=post> <select name="frameworkcode"> <option value="">Default</option> <!-- TMPL_LOOP name="frameworkloop" --> <option value="<!-- TMPL_VAR name="value" -->" <!-- TMPL_IF name="selected" -->selected<!-- /TMPL_IF -->><!-- TMPL_VAR name="frameworktext" --></option> <!-- /TMPL_LOOP --> </select> <input type=text name=searchfield value="<!-- TMPL_VAR name="searchfield" -->"> <input type="submit" value="OK" class="button"> </form> =cut | |||||
388 | ||||||
389 | sub getframeworks { | |||||
390 | ||||||
391 | # returns a reference to a hash of references to branches... | |||||
392 | 0 | 0 | my %itemtypes; | |||
393 | 0 | 0 | my $dbh = C4::Context->dbh; | |||
394 | 0 | 0 | my $sth = $dbh->prepare("select * from biblio_framework"); | |||
395 | 0 | 0 | $sth->execute; | |||
396 | 0 | 0 | while ( my $IT = $sth->fetchrow_hashref ) { | |||
397 | 0 | 0 | $itemtypes{ $IT->{'frameworkcode'} } = $IT; | |||
398 | } | |||||
399 | 0 | 0 | return ( \%itemtypes ); | |||
400 | } | |||||
401 | ||||||
402 - 408 | =head2 getframeworkinfo $frameworkinfo = &getframeworkinfo($frameworkcode); Returns information about an frameworkcode. =cut | |||||
409 | ||||||
410 | sub getframeworkinfo { | |||||
411 | 0 | 0 | my ($frameworkcode) = @_; | |||
412 | 0 | 0 | my $dbh = C4::Context->dbh; | |||
413 | 0 | 0 | my $sth = | |||
414 | $dbh->prepare("select * from biblio_framework where frameworkcode=?"); | |||||
415 | 0 | 0 | $sth->execute($frameworkcode); | |||
416 | 0 | 0 | my $res = $sth->fetchrow_hashref; | |||
417 | 0 | 0 | return $res; | |||
418 | } | |||||
419 | ||||||
420 - 426 | =head2 getitemtypeinfo $itemtype = &getitemtype($itemtype); Returns information about an itemtype. =cut | |||||
427 | ||||||
428 | sub getitemtypeinfo { | |||||
429 | 0 | 0 | my ($itemtype) = @_; | |||
430 | 0 | 0 | my $dbh = C4::Context->dbh; | |||
431 | 0 | 0 | my $sth = $dbh->prepare("select * from itemtypes where itemtype=?"); | |||
432 | 0 | 0 | $sth->execute($itemtype); | |||
433 | 0 | 0 | my $res = $sth->fetchrow_hashref; | |||
434 | ||||||
435 | 0 | 0 | $res->{imageurl} = getitemtypeimagelocation( 'intranet', $res->{imageurl} ); | |||
436 | ||||||
437 | 0 | 0 | return $res; | |||
438 | } | |||||
439 | ||||||
440 - 448 | =head2 getitemtypeimagedir my $directory = getitemtypeimagedir( 'opac' ); pass in 'opac' or 'intranet'. Defaults to 'opac'. returns the full path to the appropriate directory containing images. =cut | |||||
449 | ||||||
450 | sub getitemtypeimagedir { | |||||
451 | 0 | 0 | my $src = shift || 'opac'; | |||
452 | 0 | 0 | if ($src eq 'intranet') { | |||
453 | 0 | 0 | return C4::Context->config('intrahtdocs') . '/' .C4::Context->preference('template') . '/img/itemtypeimg'; | |||
454 | } else { | |||||
455 | 0 | 0 | return C4::Context->config('opachtdocs') . '/' . C4::Context->preference('opacthemes') . '/itemtypeimg'; | |||
456 | } | |||||
457 | } | |||||
458 | ||||||
459 | sub getitemtypeimagesrc { | |||||
460 | 0 | 0 | my $src = shift || 'opac'; | |||
461 | 0 | 0 | if ($src eq 'intranet') { | |||
462 | 0 | 0 | return '/intranet-tmpl' . '/' . C4::Context->preference('template') . '/img/itemtypeimg'; | |||
463 | } else { | |||||
464 | 0 | 0 | return '/opac-tmpl' . '/' . C4::Context->preference('opacthemes') . '/itemtypeimg'; | |||
465 | } | |||||
466 | } | |||||
467 | ||||||
468 | sub getitemtypeimagelocation($$) { | |||||
469 | 0 | 0 | my ( $src, $image ) = @_; | |||
470 | ||||||
471 | 0 | 0 | return '' if ( !$image ); | |||
472 | 0 | 0 | require URI::Split; | |||
473 | ||||||
474 | 0 | 0 | my $scheme = ( URI::Split::uri_split( $image ) )[0]; | |||
475 | ||||||
476 | 0 | 0 | return $image if ( $scheme ); | |||
477 | ||||||
478 | 0 | 0 | return getitemtypeimagesrc( $src ) . '/' . $image; | |||
479 | } | |||||
480 | ||||||
481 - 494 | =head3 _getImagesFromDirectory Find all of the image files in a directory in the filesystem parameters: a directory name returns: a list of images in that directory. Notes: this does not traverse into subdirectories. See _getSubdirectoryNames for help with that. Images are assumed to be files with .gif or .png file extensions. The image names returned do not have the directory name on them. =cut | |||||
495 | ||||||
496 | sub _getImagesFromDirectory { | |||||
497 | 0 | 0 | my $directoryname = shift; | |||
498 | 0 | 0 | return unless defined $directoryname; | |||
499 | 0 | 0 | return unless -d $directoryname; | |||
500 | ||||||
501 | 0 | 0 | if ( opendir ( my $dh, $directoryname ) ) { | |||
502 | 0 0 | 0 0 | my @images = grep { /\.(gif|png)$/i } readdir( $dh ); | |||
503 | 0 | 0 | closedir $dh; | |||
504 | 0 | 0 | @images = sort(@images); | |||
505 | 0 | 0 | return @images; | |||
506 | } else { | |||||
507 | 0 | 0 | warn "unable to opendir $directoryname: $!"; | |||
508 | 0 | 0 | return; | |||
509 | } | |||||
510 | } | |||||
511 | ||||||
512 - 524 | =head3 _getSubdirectoryNames Find all of the directories in a directory in the filesystem parameters: a directory name returns: a list of subdirectories in that directory. Notes: this does not traverse into subdirectories. Only the first level of subdirectories are returned. The directory names returned don't have the parent directory name on them. =cut | |||||
525 | ||||||
526 | sub _getSubdirectoryNames { | |||||
527 | 0 | 0 | my $directoryname = shift; | |||
528 | 0 | 0 | return unless defined $directoryname; | |||
529 | 0 | 0 | return unless -d $directoryname; | |||
530 | ||||||
531 | 0 | 0 | if ( opendir ( my $dh, $directoryname ) ) { | |||
532 | 0 0 | 0 0 | my @directories = grep { -d File::Spec->catfile( $directoryname, $_ ) && ! ( /^\./ ) } readdir( $dh ); | |||
533 | 0 | 0 | closedir $dh; | |||
534 | 0 | 0 | return @directories; | |||
535 | } else { | |||||
536 | 0 | 0 | warn "unable to opendir $directoryname: $!"; | |||
537 | 0 | 0 | return; | |||
538 | } | |||||
539 | } | |||||
540 | ||||||
541 - 558 | =head3 getImageSets returns: a listref of hashrefs. Each hash represents another collection of images. { imagesetname => 'npl', # the name of the image set (npl is the original one) images => listref of image hashrefs } each image is represented by a hashref like this: { KohaImage => 'npl/image.gif', StaffImageUrl => '/intranet-tmpl/prog/img/itemtypeimg/npl/image.gif', OpacImageURL => '/opac-tmpl/prog/itemtypeimg/npl/image.gif' checked => 0 or 1: was this the image passed to this method? Note: I'd like to remove this somehow. } =cut | |||||
559 | ||||||
560 | sub getImageSets { | |||||
561 | 0 | 0 | my %params = @_; | |||
562 | 0 | 0 | my $checked = $params{'checked'} || ''; | |||
563 | ||||||
564 | 0 | 0 | my $paths = { staff => { filesystem => getitemtypeimagedir('intranet'), | |||
565 | url => getitemtypeimagesrc('intranet'), | |||||
566 | }, | |||||
567 | opac => { filesystem => getitemtypeimagedir('opac'), | |||||
568 | url => getitemtypeimagesrc('opac'), | |||||
569 | } | |||||
570 | }; | |||||
571 | ||||||
572 | 0 | 0 | my @imagesets = (); # list of hasrefs of image set data to pass to template | |||
573 | 0 | 0 | my @subdirectories = _getSubdirectoryNames( $paths->{'staff'}{'filesystem'} ); | |||
574 | 0 | 0 | foreach my $imagesubdir ( @subdirectories ) { | |||
575 | 0 | 0 | warn $imagesubdir if $DEBUG; | |||
576 | 0 | 0 | my @imagelist = (); # hashrefs of image info | |||
577 | 0 | 0 | my @imagenames = _getImagesFromDirectory( File::Spec->catfile( $paths->{'staff'}{'filesystem'}, $imagesubdir ) ); | |||
578 | 0 | 0 | my $imagesetactive = 0; | |||
579 | 0 | 0 | foreach my $thisimage ( @imagenames ) { | |||
580 | 0 | 0 | push( @imagelist, | |||
581 | { KohaImage => "$imagesubdir/$thisimage", | |||||
582 | StaffImageUrl => join( '/', $paths->{'staff'}{'url'}, $imagesubdir, $thisimage ), | |||||
583 | OpacImageUrl => join( '/', $paths->{'opac'}{'url'}, $imagesubdir, $thisimage ), | |||||
584 | checked => "$imagesubdir/$thisimage" eq $checked ? 1 : 0, | |||||
585 | } | |||||
586 | ); | |||||
587 | 0 | 0 | $imagesetactive = 1 if "$imagesubdir/$thisimage" eq $checked; | |||
588 | } | |||||
589 | 0 | 0 | push @imagesets, { imagesetname => $imagesubdir, | |||
590 | imagesetactive => $imagesetactive, | |||||
591 | images => \@imagelist }; | |||||
592 | ||||||
593 | } | |||||
594 | 0 | 0 | return \@imagesets; | |||
595 | } | |||||
596 | ||||||
597 - 608 | =head2 GetPrinters $printers = &GetPrinters(); @queues = keys %$printers; Returns information about existing printer queues. C<$printers> is a reference-to-hash whose keys are the print queues defined in the printers table of the Koha database. The values are references-to-hash, whose keys are the fields in the printers table. =cut | |||||
609 | ||||||
610 | sub GetPrinters { | |||||
611 | 0 | 0 | my %printers; | |||
612 | 0 | 0 | my $dbh = C4::Context->dbh; | |||
613 | 0 | 0 | my $sth = $dbh->prepare("select * from printers"); | |||
614 | 0 | 0 | $sth->execute; | |||
615 | 0 | 0 | while ( my $printer = $sth->fetchrow_hashref ) { | |||
616 | 0 | 0 | $printers{ $printer->{'printqueue'} } = $printer; | |||
617 | } | |||||
618 | 0 | 0 | return ( \%printers ); | |||
619 | } | |||||
620 | ||||||
621 - 625 | =head2 GetPrinter $printer = GetPrinter( $query, $printers ); =cut | |||||
626 | ||||||
627 | sub GetPrinter ($$) { | |||||
628 | 0 | 0 | my ( $query, $printers ) = @_; # get printer for this query from printers | |||
629 | 0 | 0 | my $printer = $query->param('printer'); | |||
630 | 0 | 0 | my %cookie = $query->cookie('userenv'); | |||
631 | 0 | 0 | ($printer) || ( $printer = $cookie{'printer'} ) || ( $printer = '' ); | |||
632 | 0 | 0 | ( $printers->{$printer} ) || ( $printer = ( keys %$printers )[0] ); | |||
633 | 0 | 0 | return $printer; | |||
634 | } | |||||
635 | ||||||
636 - 641 | =head2 getnbpages Returns the number of pages to display in a pagination bar, given the number of items and the number of items per page. =cut | |||||
642 | ||||||
643 | sub getnbpages { | |||||
644 | 0 | 0 | my ( $nb_items, $nb_items_per_page ) = @_; | |||
645 | ||||||
646 | 0 | 0 | return int( ( $nb_items - 1 ) / $nb_items_per_page ) + 1; | |||
647 | } | |||||
648 | ||||||
649 - 656 | =head2 getallthemes (@themes) = &getallthemes('opac'); (@themes) = &getallthemes('intranet'); Returns an array of all available themes. =cut | |||||
657 | ||||||
658 | sub getallthemes { | |||||
659 | 0 | 0 | my $type = shift; | |||
660 | 0 | 0 | my $htdocs; | |||
661 | 0 | 0 | my @themes; | |||
662 | 0 | 0 | if ( $type eq 'intranet' ) { | |||
663 | 0 | 0 | $htdocs = C4::Context->config('intrahtdocs'); | |||
664 | } | |||||
665 | else { | |||||
666 | 0 | 0 | $htdocs = C4::Context->config('opachtdocs'); | |||
667 | } | |||||
668 | 0 | 0 | opendir D, "$htdocs"; | |||
669 | 0 | 0 | my @dirlist = readdir D; | |||
670 | 0 | 0 | foreach my $directory (@dirlist) { | |||
671 | 0 | 0 | -d "$htdocs/$directory/en" and push @themes, $directory; | |||
672 | } | |||||
673 | 0 | 0 | return @themes; | |||
674 | } | |||||
675 | ||||||
676 | sub getFacets { | |||||
677 | 0 | 0 | my $facets; | |||
678 | 0 | 0 | if ( C4::Context->preference("marcflavour") eq "UNIMARC" ) { | |||
679 | 0 | 0 | $facets = [ | |||
680 | { | |||||
681 | link_value => 'su-to', | |||||
682 | label_value => 'Topics', | |||||
683 | tags => | |||||
684 | [ '600', '601', '602', '603', '604', '605', '606', '610' ], | |||||
685 | subfield => 'a', | |||||
686 | }, | |||||
687 | { | |||||
688 | link_value => 'su-geo', | |||||
689 | label_value => 'Places', | |||||
690 | tags => ['651'], | |||||
691 | subfield => 'a', | |||||
692 | }, | |||||
693 | { | |||||
694 | link_value => 'su-ut', | |||||
695 | label_value => 'Titles', | |||||
696 | tags => [ '500', '501', '502', '503', '504', ], | |||||
697 | subfield => 'a', | |||||
698 | }, | |||||
699 | { | |||||
700 | link_value => 'au', | |||||
701 | label_value => 'Authors', | |||||
702 | tags => [ '700', '701', '702', ], | |||||
703 | subfield => 'a', | |||||
704 | }, | |||||
705 | { | |||||
706 | link_value => 'se', | |||||
707 | label_value => 'Series', | |||||
708 | tags => ['225'], | |||||
709 | subfield => 'a', | |||||
710 | }, | |||||
711 | ]; | |||||
712 | ||||||
713 | 0 | 0 | my $library_facet; | |||
714 | ||||||
715 | 0 | 0 | $library_facet = { | |||
716 | link_value => 'branch', | |||||
717 | label_value => 'Libraries', | |||||
718 | tags => [ '995', ], | |||||
719 | subfield => 'b', | |||||
720 | expanded => '1', | |||||
721 | }; | |||||
722 | 0 | 0 | push @$facets, $library_facet unless C4::Context->preference("singleBranchMode"); | |||
723 | } | |||||
724 | else { | |||||
725 | 0 | 0 | $facets = [ | |||
726 | { | |||||
727 | link_value => 'su-to', | |||||
728 | label_value => 'Topics', | |||||
729 | tags => ['650'], | |||||
730 | subfield => 'a', | |||||
731 | }, | |||||
732 | ||||||
733 | # { | |||||
734 | # link_value => 'su-na', | |||||
735 | # label_value => 'People and Organizations', | |||||
736 | # tags => ['600', '610', '611'], | |||||
737 | # subfield => 'a', | |||||
738 | # }, | |||||
739 | { | |||||
740 | link_value => 'su-geo', | |||||
741 | label_value => 'Places', | |||||
742 | tags => ['651'], | |||||
743 | subfield => 'a', | |||||
744 | }, | |||||
745 | { | |||||
746 | link_value => 'su-ut', | |||||
747 | label_value => 'Titles', | |||||
748 | tags => ['630'], | |||||
749 | subfield => 'a', | |||||
750 | }, | |||||
751 | { | |||||
752 | link_value => 'au', | |||||
753 | label_value => 'Authors', | |||||
754 | tags => [ '100', '110', '700', ], | |||||
755 | subfield => 'a', | |||||
756 | }, | |||||
757 | { | |||||
758 | link_value => 'se', | |||||
759 | label_value => 'Series', | |||||
760 | tags => [ '440', '490', ], | |||||
761 | subfield => 'a', | |||||
762 | }, | |||||
763 | ]; | |||||
764 | 0 | 0 | my $library_facet; | |||
765 | 0 | 0 | $library_facet = { | |||
766 | link_value => 'branch', | |||||
767 | label_value => 'Libraries', | |||||
768 | tags => [ '952', ], | |||||
769 | subfield => 'b', | |||||
770 | expanded => '1', | |||||
771 | }; | |||||
772 | 0 | 0 | push @$facets, $library_facet unless C4::Context->preference("singleBranchMode"); | |||
773 | } | |||||
774 | 0 | 0 | return $facets; | |||
775 | } | |||||
776 | ||||||
777 - 801 | =head2 get_infos_of Return a href where a key is associated to a href. You give a query, the name of the key among the fields returned by the query. If you also give as third argument the name of the value, the function returns a href of scalar. The optional 4th argument is an arrayref of items passed to the C<execute()> call. It is designed to bind parameters to any placeholders in your SQL. my $query = ' SELECT itemnumber, notforloan, barcode FROM items '; # generic href of any information on the item, href of href. my $iteminfos_of = get_infos_of($query, 'itemnumber'); print $iteminfos_of->{$itemnumber}{barcode}; # specific information, href of scalar my $barcode_of_item = get_infos_of($query, 'itemnumber', 'barcode'); print $barcode_of_item->{$itemnumber}; =cut | |||||
802 | ||||||
803 | sub get_infos_of { | |||||
804 | 0 | 0 | my ( $query, $key_name, $value_name, $bind_params ) = @_; | |||
805 | ||||||
806 | 0 | 0 | my $dbh = C4::Context->dbh; | |||
807 | ||||||
808 | 0 | 0 | my $sth = $dbh->prepare($query); | |||
809 | 0 | 0 | $sth->execute( @$bind_params ); | |||
810 | ||||||
811 | 0 | 0 | my %infos_of; | |||
812 | 0 | 0 | while ( my $row = $sth->fetchrow_hashref ) { | |||
813 | 0 | 0 | if ( defined $value_name ) { | |||
814 | 0 | 0 | $infos_of{ $row->{$key_name} } = $row->{$value_name}; | |||
815 | } | |||||
816 | else { | |||||
817 | 0 | 0 | $infos_of{ $row->{$key_name} } = $row; | |||
818 | } | |||||
819 | } | |||||
820 | 0 | 0 | $sth->finish; | |||
821 | ||||||
822 | 0 | 0 | return \%infos_of; | |||
823 | } | |||||
824 | ||||||
825 - 843 | =head2 get_notforloan_label_of my $notforloan_label_of = get_notforloan_label_of(); Each authorised value of notforloan (information available in items and itemtypes) is link to a single label. Returns a href where keys are authorised values and values are corresponding labels. foreach my $authorised_value (keys %{$notforloan_label_of}) { printf( "authorised_value: %s => %s\n", $authorised_value, $notforloan_label_of->{$authorised_value} ); } =cut | |||||
844 | ||||||
845 | # FIXME - why not use GetAuthorisedValues ?? | |||||
846 | # | |||||
847 | sub get_notforloan_label_of { | |||||
848 | 0 | 0 | my $dbh = C4::Context->dbh; | |||
849 | ||||||
850 | 0 | 0 | my $query = ' | |||
851 | SELECT authorised_value | |||||
852 | FROM marc_subfield_structure | |||||
853 | WHERE kohafield = \'items.notforloan\' | |||||
854 | LIMIT 0, 1 | |||||
855 | '; | |||||
856 | 0 | 0 | my $sth = $dbh->prepare($query); | |||
857 | 0 | 0 | $sth->execute(); | |||
858 | 0 | 0 | my ($statuscode) = $sth->fetchrow_array(); | |||
859 | ||||||
860 | 0 | 0 | $query = ' | |||
861 | SELECT lib, | |||||
862 | authorised_value | |||||
863 | FROM authorised_values | |||||
864 | WHERE category = ? | |||||
865 | '; | |||||
866 | 0 | 0 | $sth = $dbh->prepare($query); | |||
867 | 0 | 0 | $sth->execute($statuscode); | |||
868 | 0 | 0 | my %notforloan_label_of; | |||
869 | 0 | 0 | while ( my $row = $sth->fetchrow_hashref ) { | |||
870 | 0 | 0 | $notforloan_label_of{ $row->{authorised_value} } = $row->{lib}; | |||
871 | } | |||||
872 | 0 | 0 | $sth->finish; | |||
873 | ||||||
874 | 0 | 0 | return \%notforloan_label_of; | |||
875 | } | |||||
876 | ||||||
877 - 899 | =head2 displayServers my $servers = displayServers(); my $servers = displayServers( $position ); my $servers = displayServers( $position, $type ); displayServers returns a listref of hashrefs, each containing information about available z3950 servers. Each hashref has a format like: { 'checked' => 'checked', 'encoding' => 'MARC-8' 'icon' => undef, 'id' => 'LIBRARY OF CONGRESS', 'label' => '', 'name' => 'server', 'opensearch' => '', 'value' => 'z3950.loc.gov:7090/', 'zed' => 1, }, =cut | |||||
900 | ||||||
901 | sub displayServers { | |||||
902 | 0 | 0 | my ( $position, $type ) = @_; | |||
903 | 0 | 0 | my $dbh = C4::Context->dbh; | |||
904 | ||||||
905 | 0 | 0 | my $strsth = 'SELECT * FROM z3950servers'; | |||
906 | 0 | 0 | my @where_clauses; | |||
907 | 0 | 0 | my @bind_params; | |||
908 | ||||||
909 | 0 | 0 | if ($position) { | |||
910 | 0 | 0 | push @bind_params, $position; | |||
911 | 0 | 0 | push @where_clauses, ' position = ? '; | |||
912 | } | |||||
913 | ||||||
914 | 0 | 0 | if ($type) { | |||
915 | 0 | 0 | push @bind_params, $type; | |||
916 | 0 | 0 | push @where_clauses, ' type = ? '; | |||
917 | } | |||||
918 | ||||||
919 | # reassemble where clause from where clause pieces | |||||
920 | 0 | 0 | if (@where_clauses) { | |||
921 | 0 | 0 | $strsth .= ' WHERE ' . join( ' AND ', @where_clauses ); | |||
922 | } | |||||
923 | ||||||
924 | 0 | 0 | my $rq = $dbh->prepare($strsth); | |||
925 | 0 | 0 | $rq->execute(@bind_params); | |||
926 | 0 | 0 | my @primaryserverloop; | |||
927 | ||||||
928 | 0 | 0 | while ( my $data = $rq->fetchrow_hashref ) { | |||
929 | 0 | 0 | push @primaryserverloop, | |||
930 | { label => $data->{description}, | |||||
931 | id => $data->{name}, | |||||
932 | name => "server", | |||||
933 | value => $data->{host} . ":" . $data->{port} . "/" . $data->{database}, | |||||
934 | encoding => ( $data->{encoding} ? $data->{encoding} : "iso-5426" ), | |||||
935 | checked => "checked", | |||||
936 | icon => $data->{icon}, | |||||
937 | zed => $data->{type} eq 'zed', | |||||
938 | opensearch => $data->{type} eq 'opensearch' | |||||
939 | }; | |||||
940 | } | |||||
941 | 0 | 0 | return \@primaryserverloop; | |||
942 | } | |||||
943 | ||||||
944 | ||||||
945 - 951 | =head2 GetKohaImageurlFromAuthorisedValues $authhorised_value = GetKohaImageurlFromAuthorisedValues( $category, $authvalcode ); Return the first url of the authorised value image represented by $lib. =cut | |||||
952 | ||||||
953 | sub GetKohaImageurlFromAuthorisedValues { | |||||
954 | 0 | 0 | my ( $category, $lib ) = @_; | |||
955 | 0 | 0 | my $dbh = C4::Context->dbh; | |||
956 | 0 | 0 | my $sth = $dbh->prepare("SELECT imageurl FROM authorised_values WHERE category=? AND lib =?"); | |||
957 | 0 | 0 | $sth->execute( $category, $lib ); | |||
958 | 0 | 0 | while ( my $data = $sth->fetchrow_hashref ) { | |||
959 | 0 | 0 | return $data->{'imageurl'}; | |||
960 | } | |||||
961 | } | |||||
962 | ||||||
963 - 967 | =head2 GetAuthValCode $authvalcode = GetAuthValCode($kohafield,$frameworkcode); =cut | |||||
968 | ||||||
969 | sub GetAuthValCode { | |||||
970 | 0 | 0 | my ($kohafield,$fwcode) = @_; | |||
971 | 0 | 0 | my $dbh = C4::Context->dbh; | |||
972 | 0 | 0 | $fwcode='' unless $fwcode; | |||
973 | 0 | 0 | my $sth = $dbh->prepare('select authorised_value from marc_subfield_structure where kohafield=? and frameworkcode=?'); | |||
974 | 0 | 0 | $sth->execute($kohafield,$fwcode); | |||
975 | 0 | 0 | my ($authvalcode) = $sth->fetchrow_array; | |||
976 | 0 | 0 | return $authvalcode; | |||
977 | } | |||||
978 | ||||||
979 - 985 | =head2 GetAuthValCodeFromField $authvalcode = GetAuthValCodeFromField($field,$subfield,$frameworkcode); C<$subfield> can be undefined =cut | |||||
986 | ||||||
987 | sub GetAuthValCodeFromField { | |||||
988 | 0 | 0 | my ($field,$subfield,$fwcode) = @_; | |||
989 | 0 | 0 | my $dbh = C4::Context->dbh; | |||
990 | 0 | 0 | $fwcode='' unless $fwcode; | |||
991 | 0 | 0 | my $sth; | |||
992 | 0 | 0 | if (defined $subfield) { | |||
993 | 0 | 0 | $sth = $dbh->prepare('select authorised_value from marc_subfield_structure where tagfield=? and tagsubfield=? and frameworkcode=?'); | |||
994 | 0 | 0 | $sth->execute($field,$subfield,$fwcode); | |||
995 | } else { | |||||
996 | 0 | 0 | $sth = $dbh->prepare('select authorised_value from marc_tag_structure where tagfield=? and frameworkcode=?'); | |||
997 | 0 | 0 | $sth->execute($field,$fwcode); | |||
998 | } | |||||
999 | 0 | 0 | my ($authvalcode) = $sth->fetchrow_array; | |||
1000 | 0 | 0 | return $authvalcode; | |||
1001 | } | |||||
1002 | ||||||
1003 - 1013 | =head2 GetAuthorisedValues $authvalues = GetAuthorisedValues([$category], [$selected]); This function returns all authorised values from the'authorised_value' table in a reference to array of hashrefs. C<$category> returns authorised values for just one category (optional). C<$opac> If set to a true value, displays OPAC descriptions rather than normal ones when they exist. =cut | |||||
1014 | ||||||
1015 | sub GetAuthorisedValues { | |||||
1016 | my ($category,$selected,$opac) = @_; | |||||
1017 | my @results; | |||||
1018 | my $dbh = C4::Context->dbh; | |||||
1019 | my $query = "SELECT * FROM authorised_values"; | |||||
1020 | $query .= " WHERE category = '" . $category . "'" if $category; | |||||
1021 | $query .= " ORDER BY category, lib, lib_opac"; | |||||
1022 | my $sth = $dbh->prepare($query); | |||||
1023 | $sth->execute; | |||||
1024 | while (my $data=$sth->fetchrow_hashref) { | |||||
1025 | if ($selected && $selected eq $data->{'authorised_value'} ) { | |||||
1026 | $data->{'selected'} = 1; | |||||
1027 | } | |||||
1028 | if ($opac && $data->{'lib_opac'}) { | |||||
1029 | $data->{'lib'} = $data->{'lib_opac'}; | |||||
1030 | } | |||||
1031 | push @results, $data; | |||||
1032 | } | |||||
1033 | #my $data = $sth->fetchall_arrayref({}); | |||||
1034 | return \@results; #$data; | |||||
1035 | } | |||||
1036 | ||||||
1037 - 1044 | =head2 GetAuthorisedValueCategories $auth_categories = GetAuthorisedValueCategories(); Return an arrayref of all of the available authorised value categories. =cut | |||||
1045 | ||||||
1046 | sub GetAuthorisedValueCategories { | |||||
1047 | 0 | 0 | my $dbh = C4::Context->dbh; | |||
1048 | 0 | 0 | my $sth = $dbh->prepare("SELECT DISTINCT category FROM authorised_values ORDER BY category"); | |||
1049 | 0 | 0 | $sth->execute; | |||
1050 | 0 | 0 | my @results; | |||
1051 | 0 | 0 | while (defined (my $category = $sth->fetchrow_array) ) { | |||
1052 | 0 | 0 | push @results, $category; | |||
1053 | } | |||||
1054 | 0 | 0 | return \@results; | |||
1055 | } | |||||
1056 | ||||||
1057 - 1064 | =head2 GetAuthorisedValueByCode $authhorised_value = GetAuthorisedValueByCode( $category, $authvalcode ); Return the lib attribute from authorised_values from the row identified by the passed category and code =cut | |||||
1065 | ||||||
1066 | sub GetAuthorisedValueByCode { | |||||
1067 | 0 | 0 | my ( $category, $authvalcode ) = @_; | |||
1068 | ||||||
1069 | 0 | 0 | my $dbh = C4::Context->dbh; | |||
1070 | 0 | 0 | my $sth = $dbh->prepare("SELECT lib FROM authorised_values WHERE category=? AND authorised_value =?"); | |||
1071 | 0 | 0 | $sth->execute( $category, $authvalcode ); | |||
1072 | 0 | 0 | while ( my $data = $sth->fetchrow_hashref ) { | |||
1073 | 0 | 0 | return $data->{'lib'}; | |||
1074 | } | |||||
1075 | } | |||||
1076 | ||||||
1077 - 1087 | =head2 GetKohaAuthorisedValues Takes $kohafield, $fwcode as parameters. If $opac parameter is set to a true value, displays OPAC descriptions rather than normal ones when they exist. Returns hashref of Code => description Returns undef if no authorised value category is defined for the kohafield. =cut | |||||
1088 | ||||||
1089 | sub GetKohaAuthorisedValues { | |||||
1090 | 0 | 0 | my ($kohafield,$fwcode,$opac) = @_; | |||
1091 | 0 | 0 | $fwcode='' unless $fwcode; | |||
1092 | 0 | 0 | my %values; | |||
1093 | 0 | 0 | my $dbh = C4::Context->dbh; | |||
1094 | 0 | 0 | my $avcode = GetAuthValCode($kohafield,$fwcode); | |||
1095 | 0 | 0 | if ($avcode) { | |||
1096 | 0 | 0 | my $sth = $dbh->prepare("select authorised_value, lib, lib_opac from authorised_values where category=? "); | |||
1097 | 0 | 0 | $sth->execute($avcode); | |||
1098 | 0 | 0 | while ( my ($val, $lib, $lib_opac) = $sth->fetchrow_array ) { | |||
1099 | 0 | 0 | $values{$val} = ($opac && $lib_opac) ? $lib_opac : $lib; | |||
1100 | } | |||||
1101 | 0 | 0 | return \%values; | |||
1102 | } else { | |||||
1103 | 0 | 0 | return undef; | |||
1104 | } | |||||
1105 | } | |||||
1106 | ||||||
1107 - 1118 | =head2 GetKohaAuthorisedValuesFromField Takes $field, $subfield, $fwcode as parameters. If $opac parameter is set to a true value, displays OPAC descriptions rather than normal ones when they exist. $subfield can be undefined Returns hashref of Code => description Returns undef if no authorised value category is defined for the given field and subfield =cut | |||||
1119 | ||||||
1120 | sub GetKohaAuthorisedValuesFromField { | |||||
1121 | 0 | 0 | my ($field, $subfield, $fwcode,$opac) = @_; | |||
1122 | 0 | 0 | $fwcode='' unless $fwcode; | |||
1123 | 0 | 0 | my %values; | |||
1124 | 0 | 0 | my $dbh = C4::Context->dbh; | |||
1125 | 0 | 0 | my $avcode = GetAuthValCodeFromField($field, $subfield, $fwcode); | |||
1126 | 0 | 0 | if ($avcode) { | |||
1127 | 0 | 0 | my $sth = $dbh->prepare("select authorised_value, lib, lib_opac from authorised_values where category=? "); | |||
1128 | 0 | 0 | $sth->execute($avcode); | |||
1129 | 0 | 0 | while ( my ($val, $lib, $lib_opac) = $sth->fetchrow_array ) { | |||
1130 | 0 | 0 | $values{$val} = ($opac && $lib_opac) ? $lib_opac : $lib; | |||
1131 | } | |||||
1132 | 0 | 0 | return \%values; | |||
1133 | } else { | |||||
1134 | 0 | 0 | return undef; | |||
1135 | } | |||||
1136 | } | |||||
1137 | ||||||
1138 - 1144 | =head2 xml_escape my $escaped_string = C4::Koha::xml_escape($string); Convert &, <, >, ', and " in a string to XML entities =cut | |||||
1145 | ||||||
1146 | sub xml_escape { | |||||
1147 | 4 | 940 | my $str = shift; | |||
1148 | 4 | 27 | return '' unless defined $str; | |||
1149 | 2 | 14 | $str =~ s/&/&/g; | |||
1150 | 2 | 7 | $str =~ s/</</g; | |||
1151 | 2 | 6 | $str =~ s/>/>/g; | |||
1152 | 2 | 8 | $str =~ s/'/'/g; | |||
1153 | 2 | 7 | $str =~ s/"/"/g; | |||
1154 | 2 | 16 | return $str; | |||
1155 | } | |||||
1156 | ||||||
1157 - 1165 | =head2 GetKohaAuthorisedValueLib Takes $category, $authorised_value as parameters. If $opac parameter is set to a true value, displays OPAC descriptions rather than normal ones when they exist. Returns authorised value description =cut | |||||
1166 | ||||||
1167 | sub GetKohaAuthorisedValueLib { | |||||
1168 | 0 | 0 | my ($category,$authorised_value,$opac) = @_; | |||
1169 | 0 | 0 | my $value; | |||
1170 | 0 | 0 | my $dbh = C4::Context->dbh; | |||
1171 | 0 | 0 | my $sth = $dbh->prepare("select lib, lib_opac from authorised_values where category=? and authorised_value=?"); | |||
1172 | 0 | 0 | $sth->execute($category,$authorised_value); | |||
1173 | 0 | 0 | my $data = $sth->fetchrow_hashref; | |||
1174 | 0 | 0 | $value = ($opac && $$data{'lib_opac'}) ? $$data{'lib_opac'} : $$data{'lib'}; | |||
1175 | 0 | 0 | return $value; | |||
1176 | } | |||||
1177 | ||||||
1178 - 1187 | =head2 display_marc_indicators my $display_form = C4::Koha::display_marc_indicators($field); C<$field> is a MARC::Field object Generate a display form of the indicators of a variable MARC field, replacing any blanks with '#'. =cut | |||||
1188 | ||||||
1189 | sub display_marc_indicators { | |||||
1190 | 0 | 0 | my $field = shift; | |||
1191 | 0 | 0 | my $indicators = ''; | |||
1192 | 0 | 0 | if ($field->tag() >= 10) { | |||
1193 | 0 | 0 | $indicators = $field->indicator(1) . $field->indicator(2); | |||
1194 | 0 | 0 | $indicators =~ s/ /#/g; | |||
1195 | } | |||||
1196 | 0 | 0 | return $indicators; | |||
1197 | } | |||||
1198 | ||||||
1199 | sub GetNormalizedUPC { | |||||
1200 | 0 | 0 | my ($record,$marcflavour) = @_; | |||
1201 | 0 | 0 | my (@fields,$upc); | |||
1202 | ||||||
1203 | 0 | 0 | if ($marcflavour eq 'UNIMARC') { | |||
1204 | 0 | 0 | @fields = $record->field('072'); | |||
1205 | 0 | 0 | foreach my $field (@fields) { | |||
1206 | 0 | 0 | my $upc = _normalize_match_point($field->subfield('a')); | |||
1207 | 0 | 0 | if ($upc ne '') { | |||
1208 | 0 | 0 | return $upc; | |||
1209 | } | |||||
1210 | } | |||||
1211 | ||||||
1212 | } | |||||
1213 | else { # assume marc21 if not unimarc | |||||
1214 | 0 | 0 | @fields = $record->field('024'); | |||
1215 | 0 | 0 | foreach my $field (@fields) { | |||
1216 | 0 | 0 | my $indicator = $field->indicator(1); | |||
1217 | 0 | 0 | my $upc = _normalize_match_point($field->subfield('a')); | |||
1218 | 0 | 0 | if ($indicator == 1 and $upc ne '') { | |||
1219 | 0 | 0 | return $upc; | |||
1220 | } | |||||
1221 | } | |||||
1222 | } | |||||
1223 | } | |||||
1224 | ||||||
1225 | # Normalizes and returns the first valid ISBN found in the record | |||||
1226 | # ISBN13 are converted into ISBN10. This is required to get Amazon cover book. | |||||
1227 | sub GetNormalizedISBN { | |||||
1228 | 0 | 0 | my ($isbn,$record,$marcflavour) = @_; | |||
1229 | 0 | 0 | my @fields; | |||
1230 | 0 | 0 | if ($isbn) { | |||
1231 | # Koha attempts to store multiple ISBNs in biblioitems.isbn, separated by " | " | |||||
1232 | # anything after " | " should be removed, along with the delimiter | |||||
1233 | 0 | 0 | $isbn =~ s/(.*)( \| )(.*)/$1/; | |||
1234 | 0 | 0 | return _isbn_cleanup($isbn); | |||
1235 | } | |||||
1236 | 0 | 0 | return undef unless $record; | |||
1237 | ||||||
1238 | 0 | 0 | if ($marcflavour eq 'UNIMARC') { | |||
1239 | 0 | 0 | @fields = $record->field('010'); | |||
1240 | 0 | 0 | foreach my $field (@fields) { | |||
1241 | 0 | 0 | my $isbn = $field->subfield('a'); | |||
1242 | 0 | 0 | if ($isbn) { | |||
1243 | 0 | 0 | return _isbn_cleanup($isbn); | |||
1244 | } else { | |||||
1245 | 0 | 0 | return undef; | |||
1246 | } | |||||
1247 | } | |||||
1248 | } | |||||
1249 | else { # assume marc21 if not unimarc | |||||
1250 | 0 | 0 | @fields = $record->field('020'); | |||
1251 | 0 | 0 | foreach my $field (@fields) { | |||
1252 | 0 | 0 | $isbn = $field->subfield('a'); | |||
1253 | 0 | 0 | if ($isbn) { | |||
1254 | 0 | 0 | return _isbn_cleanup($isbn); | |||
1255 | } else { | |||||
1256 | 0 | 0 | return undef; | |||
1257 | } | |||||
1258 | } | |||||
1259 | } | |||||
1260 | } | |||||
1261 | ||||||
1262 | sub GetNormalizedEAN { | |||||
1263 | 0 | 0 | my ($record,$marcflavour) = @_; | |||
1264 | 0 | 0 | my (@fields,$ean); | |||
1265 | ||||||
1266 | 0 | 0 | if ($marcflavour eq 'UNIMARC') { | |||
1267 | 0 | 0 | @fields = $record->field('073'); | |||
1268 | 0 | 0 | foreach my $field (@fields) { | |||
1269 | 0 | 0 | $ean = _normalize_match_point($field->subfield('a')); | |||
1270 | 0 | 0 | if ($ean ne '') { | |||
1271 | 0 | 0 | return $ean; | |||
1272 | } | |||||
1273 | } | |||||
1274 | } | |||||
1275 | else { # assume marc21 if not unimarc | |||||
1276 | 0 | 0 | @fields = $record->field('024'); | |||
1277 | 0 | 0 | foreach my $field (@fields) { | |||
1278 | 0 | 0 | my $indicator = $field->indicator(1); | |||
1279 | 0 | 0 | $ean = _normalize_match_point($field->subfield('a')); | |||
1280 | 0 | 0 | if ($indicator == 3 and $ean ne '') { | |||
1281 | 0 | 0 | return $ean; | |||
1282 | } | |||||
1283 | } | |||||
1284 | } | |||||
1285 | } | |||||
1286 | sub GetNormalizedOCLCNumber { | |||||
1287 | 0 | 0 | my ($record,$marcflavour) = @_; | |||
1288 | 0 | 0 | my (@fields,$oclc); | |||
1289 | ||||||
1290 | 0 | 0 | if ($marcflavour eq 'UNIMARC') { | |||
1291 | # TODO: add UNIMARC fields | |||||
1292 | } | |||||
1293 | else { # assume marc21 if not unimarc | |||||
1294 | 0 | 0 | @fields = $record->field('035'); | |||
1295 | 0 | 0 | foreach my $field (@fields) { | |||
1296 | 0 | 0 | $oclc = $field->subfield('a'); | |||
1297 | 0 | 0 | if ($oclc =~ /OCoLC/) { | |||
1298 | 0 | 0 | $oclc =~ s/\(OCoLC\)//; | |||
1299 | 0 | 0 | return $oclc; | |||
1300 | } else { | |||||
1301 | 0 | 0 | return undef; | |||
1302 | } | |||||
1303 | } | |||||
1304 | } | |||||
1305 | } | |||||
1306 | ||||||
1307 | sub _normalize_match_point { | |||||
1308 | 0 | 0 | my $match_point = shift; | |||
1309 | 0 | 0 | (my $normalized_match_point) = $match_point =~ /([\d-]*[X]*)/; | |||
1310 | 0 | 0 | $normalized_match_point =~ s/-//g; | |||
1311 | ||||||
1312 | 0 | 0 | return $normalized_match_point; | |||
1313 | } | |||||
1314 | ||||||
1315 | sub _isbn_cleanup { | |||||
1316 | 6 | 3184 | require Business::ISBN; | |||
1317 | 6 | 23838 | my $isbn = Business::ISBN->new( $_[0] ); | |||
1318 | 6 | 1675 | if ( $isbn ) { | |||
1319 | 6 | 99 | $isbn = $isbn->as_isbn10 if $isbn->type eq 'ISBN13'; | |||
1320 | 6 | 767 | if (defined $isbn) { | |||
1321 | 6 | 57 | return $isbn->as_string([]); | |||
1322 | } | |||||
1323 | } | |||||
1324 | 0 | return; | ||||
1325 | } | |||||
1326 | ||||||
1327 | 1; | |||||
1328 |