Bug 14695: Fix typo in template
[koha.git] / C4 / Koha.pm
blobbb3581123d9dc23a1298612238667baa02d075c3
1 package C4::Koha;
3 # Copyright 2000-2002 Katipo Communications
4 # Parts Copyright 2010 Nelsonville Public Library
5 # Parts copyright 2010 BibLibre
7 # This file is part of Koha.
9 # Koha is free software; you can redistribute it and/or modify it
10 # under the terms of the GNU General Public License as published by
11 # the Free Software Foundation; either version 3 of the License, or
12 # (at your option) any later version.
14 # Koha is distributed in the hope that it will be useful, but
15 # WITHOUT ANY WARRANTY; without even the implied warranty of
16 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17 # GNU General Public License for more details.
19 # You should have received a copy of the GNU General Public License
20 # along with Koha; if not, see <http://www.gnu.org/licenses>.
23 use strict;
24 #use warnings; FIXME - Bug 2505
26 use C4::Context;
27 use C4::Branch; # Can be removed?
28 use Koha::Cache;
29 use Koha::DateUtils qw(dt_from_string);
30 use Koha::Libraries;
31 use DateTime::Format::MySQL;
32 use Business::ISBN;
33 use autouse 'Data::cselectall_arrayref' => qw(Dumper);
34 use DBI qw(:sql_types);
35 use vars qw(@ISA @EXPORT @EXPORT_OK $DEBUG);
37 BEGIN {
38 require Exporter;
39 @ISA = qw(Exporter);
40 @EXPORT = qw(
41 &GetPrinters &GetPrinter
42 &GetItemTypes &getitemtypeinfo
43 &GetItemTypesCategorized &GetItemTypesByCategory
44 &GetSupportName &GetSupportList
45 &getframeworks &getframeworkinfo
46 &GetFrameworksLoop
47 &getallthemes
48 &getFacets
49 &getnbpages
50 &get_infos_of
51 &get_notforloan_label_of
52 &getitemtypeimagedir
53 &getitemtypeimagesrc
54 &getitemtypeimagelocation
55 &GetAuthorisedValues
56 &GetAuthorisedValueCategories
57 &GetKohaAuthorisedValues
58 &GetKohaAuthorisedValuesFromField
59 &GetKohaAuthorisedValuesMapping
60 &GetKohaAuthorisedValueLib
61 &GetAuthorisedValueByCode
62 &GetAuthValCode
63 &GetNormalizedUPC
64 &GetNormalizedISBN
65 &GetNormalizedEAN
66 &GetNormalizedOCLCNumber
67 &xml_escape
69 &GetVariationsOfISBN
70 &GetVariationsOfISBNs
71 &NormalizeISBN
73 $DEBUG
75 $DEBUG = 0;
76 @EXPORT_OK = qw( GetDailyQuote );
79 =head1 NAME
81 C4::Koha - Perl Module containing convenience functions for Koha scripts
83 =head1 SYNOPSIS
85 use C4::Koha;
87 =head1 DESCRIPTION
89 Koha.pm provides many functions for Koha scripts.
91 =head1 FUNCTIONS
93 =cut
95 =head2 GetSupportName
97 $itemtypename = &GetSupportName($codestring);
99 Returns a string with the name of the itemtype.
101 =cut
103 sub GetSupportName{
104 my ($codestring)=@_;
105 return if (! $codestring);
106 my $resultstring;
107 my $advanced_search_types = C4::Context->preference("AdvancedSearchTypes");
108 if (!$advanced_search_types or $advanced_search_types eq 'itemtypes') {
109 my $query = qq|
110 SELECT description
111 FROM itemtypes
112 WHERE itemtype=?
113 order by description
115 my $sth = C4::Context->dbh->prepare($query);
116 $sth->execute($codestring);
117 ($resultstring)=$sth->fetchrow;
118 return $resultstring;
119 } else {
120 my $sth =
121 C4::Context->dbh->prepare(
122 "SELECT lib FROM authorised_values WHERE category = ? AND authorised_value = ?"
124 $sth->execute( $advanced_search_types, $codestring );
125 my $data = $sth->fetchrow_hashref;
126 return $$data{'lib'};
130 =head2 GetSupportList
132 $itemtypes = &GetSupportList();
134 Returns an array ref containing informations about Support (since itemtype is rather a circulation code when item-level-itypes is used).
136 build a HTML select with the following code :
138 =head3 in PERL SCRIPT
140 my $itemtypes = GetSupportList();
141 $template->param(itemtypeloop => $itemtypes);
143 =head3 in TEMPLATE
145 <select name="itemtype" id="itemtype">
146 <option value=""></option>
147 [% FOREACH itemtypeloo IN itemtypeloop %]
148 [% IF ( itemtypeloo.selected ) %]
149 <option value="[% itemtypeloo.itemtype %]" selected="selected">[% itemtypeloo.description %]</option>
150 [% ELSE %]
151 <option value="[% itemtypeloo.itemtype %]">[% itemtypeloo.description %]</option>
152 [% END %]
153 [% END %]
154 </select>
156 =cut
158 sub GetSupportList{
159 my $advanced_search_types = C4::Context->preference("AdvancedSearchTypes");
160 if (!$advanced_search_types or $advanced_search_types =~ /itemtypes/) {
161 return GetItemTypes( style => 'array' );
162 } else {
163 my $advsearchtypes = GetAuthorisedValues($advanced_search_types);
164 my @results= map {{itemtype=>$$_{authorised_value},description=>$$_{lib},imageurl=>$$_{imageurl}}} @$advsearchtypes;
165 return \@results;
168 =head2 GetItemTypes
170 $itemtypes = &GetItemTypes( style => $style );
172 Returns information about existing itemtypes.
174 Params:
175 style: either 'array' or 'hash', defaults to 'hash'.
176 'array' returns an arrayref,
177 'hash' return a hashref with the itemtype value as the key
179 build a HTML select with the following code :
181 =head3 in PERL SCRIPT
183 my $itemtypes = GetItemTypes;
184 my @itemtypesloop;
185 foreach my $thisitemtype (sort keys %$itemtypes) {
186 my $selected = 1 if $thisitemtype eq $itemtype;
187 my %row =(value => $thisitemtype,
188 selected => $selected,
189 description => $itemtypes->{$thisitemtype}->{'description'},
191 push @itemtypesloop, \%row;
193 $template->param(itemtypeloop => \@itemtypesloop);
195 =head3 in TEMPLATE
197 <form action='<!-- TMPL_VAR name="script_name" -->' method=post>
198 <select name="itemtype">
199 <option value="">Default</option>
200 <!-- TMPL_LOOP name="itemtypeloop" -->
201 <option value="<!-- TMPL_VAR name="value" -->" <!-- TMPL_IF name="selected" -->selected<!-- /TMPL_IF -->><!-- TMPL_VAR name="description" --></option>
202 <!-- /TMPL_LOOP -->
203 </select>
204 <input type=text name=searchfield value="<!-- TMPL_VAR name="searchfield" -->">
205 <input type="submit" value="OK" class="button">
206 </form>
208 =cut
210 sub GetItemTypes {
211 my ( %params ) = @_;
212 my $style = defined( $params{'style'} ) ? $params{'style'} : 'hash';
214 require C4::Languages;
215 my $language = C4::Languages::getlanguage();
216 # returns a reference to a hash of references to itemtypes...
217 my $dbh = C4::Context->dbh;
218 my $query = q|
219 SELECT
220 itemtypes.itemtype,
221 itemtypes.description,
222 itemtypes.rentalcharge,
223 itemtypes.notforloan,
224 itemtypes.imageurl,
225 itemtypes.summary,
226 itemtypes.checkinmsg,
227 itemtypes.checkinmsgtype,
228 itemtypes.sip_media_type,
229 itemtypes.hideinopac,
230 itemtypes.searchcategory,
231 COALESCE( localization.translation, itemtypes.description ) AS translated_description
232 FROM itemtypes
233 LEFT JOIN localization ON itemtypes.itemtype = localization.code
234 AND localization.entity = 'itemtypes'
235 AND localization.lang = ?
236 ORDER BY itemtype
238 my $sth = $dbh->prepare($query);
239 $sth->execute( $language );
241 if ( $style eq 'hash' ) {
242 my %itemtypes;
243 while ( my $IT = $sth->fetchrow_hashref ) {
244 $itemtypes{ $IT->{'itemtype'} } = $IT;
246 return ( \%itemtypes );
247 } else {
248 return [ sort { lc $a->{translated_description} cmp lc $b->{translated_description} } @{ $sth->fetchall_arrayref( {} ) } ];
252 =head2 GetItemTypesCategorized
254 $categories = GetItemTypesCategorized();
256 Returns a hashref containing search categories.
257 A search category will be put in the hash if at least one of its itemtypes is visible in OPAC.
258 The categories must be part of Authorized Values (ITEMTYPECAT)
260 =cut
262 sub GetItemTypesCategorized {
263 my $dbh = C4::Context->dbh;
264 # Order is important, so that partially hidden (some items are not visible in OPAC) search
265 # categories will be visible. hideinopac=0 must be last.
266 my $query = q|
267 SELECT itemtype, description, imageurl, hideinopac, 0 as 'iscat' FROM itemtypes WHERE ISNULL(searchcategory) or length(searchcategory) = 0
268 UNION
269 SELECT DISTINCT searchcategory AS `itemtype`,
270 authorised_values.lib_opac AS description,
271 authorised_values.imageurl AS imageurl,
272 hideinopac, 1 as 'iscat'
273 FROM itemtypes
274 LEFT JOIN authorised_values ON searchcategory = authorised_value
275 WHERE searchcategory > '' and hideinopac=1
276 UNION
277 SELECT DISTINCT searchcategory AS `itemtype`,
278 authorised_values.lib_opac AS description,
279 authorised_values.imageurl AS imageurl,
280 hideinopac, 1 as 'iscat'
281 FROM itemtypes
282 LEFT JOIN authorised_values ON searchcategory = authorised_value
283 WHERE searchcategory > '' and hideinopac=0
285 return ($dbh->selectall_hashref($query,'itemtype'));
288 =head2 GetItemTypesByCategory
290 @results = GetItemTypesByCategory( $searchcategory );
292 Returns the itemtype code of all itemtypes included in a searchcategory.
294 =cut
296 sub GetItemTypesByCategory {
297 my ($category) = @_;
298 my $count = 0;
299 my @results;
300 my $dbh = C4::Context->dbh;
301 my $query = qq|SELECT itemtype FROM itemtypes WHERE searchcategory=?|;
302 my $tmp=$dbh->selectcol_arrayref($query,undef,$category);
303 return @$tmp;
306 =head2 getframework
308 $frameworks = &getframework();
310 Returns information about existing frameworks
312 build a HTML select with the following code :
314 =head3 in PERL SCRIPT
316 my $frameworks = getframeworks();
317 my @frameworkloop;
318 foreach my $thisframework (keys %$frameworks) {
319 my $selected = 1 if $thisframework eq $frameworkcode;
320 my %row =(
321 value => $thisframework,
322 selected => $selected,
323 description => $frameworks->{$thisframework}->{'frameworktext'},
325 push @frameworksloop, \%row;
327 $template->param(frameworkloop => \@frameworksloop);
329 =head3 in TEMPLATE
331 <form action="[% script_name %] method=post>
332 <select name="frameworkcode">
333 <option value="">Default</option>
334 [% FOREACH framework IN frameworkloop %]
335 [% IF ( framework.selected ) %]
336 <option value="[% framework.value %]" selected="selected">[% framework.description %]</option>
337 [% ELSE %]
338 <option value="[% framework.value %]">[% framework.description %]</option>
339 [% END %]
340 [% END %]
341 </select>
342 <input type=text name=searchfield value="[% searchfield %]">
343 <input type="submit" value="OK" class="button">
344 </form>
346 =cut
348 sub getframeworks {
350 # returns a reference to a hash of references to branches...
351 my %itemtypes;
352 my $dbh = C4::Context->dbh;
353 my $sth = $dbh->prepare("select * from biblio_framework");
354 $sth->execute;
355 while ( my $IT = $sth->fetchrow_hashref ) {
356 $itemtypes{ $IT->{'frameworkcode'} } = $IT;
358 return ( \%itemtypes );
361 =head2 GetFrameworksLoop
363 $frameworks = GetFrameworksLoop( $frameworkcode );
365 Returns the loop suggested on getframework(), but ordered by framework description.
367 build a HTML select with the following code :
369 =head3 in PERL SCRIPT
371 $template->param( frameworkloop => GetFrameworksLoop( $frameworkcode ) );
373 =head3 in TEMPLATE
375 Same as getframework()
377 <form action="[% script_name %] method=post>
378 <select name="frameworkcode">
379 <option value="">Default</option>
380 [% FOREACH framework IN frameworkloop %]
381 [% IF ( framework.selected ) %]
382 <option value="[% framework.value %]" selected="selected">[% framework.description %]</option>
383 [% ELSE %]
384 <option value="[% framework.value %]">[% framework.description %]</option>
385 [% END %]
386 [% END %]
387 </select>
388 <input type=text name=searchfield value="[% searchfield %]">
389 <input type="submit" value="OK" class="button">
390 </form>
392 =cut
394 sub GetFrameworksLoop {
395 my $frameworkcode = shift;
396 my $frameworks = getframeworks();
397 my @frameworkloop;
398 foreach my $thisframework (sort { uc($frameworks->{$a}->{'frameworktext'}) cmp uc($frameworks->{$b}->{'frameworktext'}) } keys %$frameworks) {
399 my $selected = ( $thisframework eq $frameworkcode ) ? 1 : undef;
400 my %row = (
401 value => $thisframework,
402 selected => $selected,
403 description => $frameworks->{$thisframework}->{'frameworktext'},
405 push @frameworkloop, \%row;
407 return \@frameworkloop;
410 =head2 getframeworkinfo
412 $frameworkinfo = &getframeworkinfo($frameworkcode);
414 Returns information about an frameworkcode.
416 =cut
418 sub getframeworkinfo {
419 my ($frameworkcode) = @_;
420 my $dbh = C4::Context->dbh;
421 my $sth =
422 $dbh->prepare("select * from biblio_framework where frameworkcode=?");
423 $sth->execute($frameworkcode);
424 my $res = $sth->fetchrow_hashref;
425 return $res;
428 =head2 getitemtypeinfo
430 $itemtype = &getitemtypeinfo($itemtype, [$interface]);
432 Returns information about an itemtype. The optional $interface argument
433 sets which interface ('opac' or 'intranet') to return the imageurl for.
434 Defaults to intranet.
436 =cut
438 sub getitemtypeinfo {
439 my ($itemtype, $interface) = @_;
440 my $dbh = C4::Context->dbh;
441 require C4::Languages;
442 my $language = C4::Languages::getlanguage();
443 my $it = $dbh->selectrow_hashref(q|
444 SELECT
445 itemtypes.itemtype,
446 itemtypes.description,
447 itemtypes.rentalcharge,
448 itemtypes.notforloan,
449 itemtypes.imageurl,
450 itemtypes.summary,
451 itemtypes.checkinmsg,
452 itemtypes.checkinmsgtype,
453 itemtypes.sip_media_type,
454 COALESCE( localization.translation, itemtypes.description ) AS translated_description
455 FROM itemtypes
456 LEFT JOIN localization ON itemtypes.itemtype = localization.code
457 AND localization.entity = 'itemtypes'
458 AND localization.lang = ?
459 WHERE itemtypes.itemtype = ?
460 |, undef, $language, $itemtype );
462 $it->{imageurl} = getitemtypeimagelocation( ( ( defined $interface && $interface eq 'opac' ) ? 'opac' : 'intranet' ), $it->{imageurl} );
464 return $it;
467 =head2 getitemtypeimagedir
469 my $directory = getitemtypeimagedir( 'opac' );
471 pass in 'opac' or 'intranet'. Defaults to 'opac'.
473 returns the full path to the appropriate directory containing images.
475 =cut
477 sub getitemtypeimagedir {
478 my $src = shift || 'opac';
479 if ($src eq 'intranet') {
480 return C4::Context->config('intrahtdocs') . '/' .C4::Context->preference('template') . '/img/itemtypeimg';
481 } else {
482 return C4::Context->config('opachtdocs') . '/' . C4::Context->preference('opacthemes') . '/itemtypeimg';
486 sub getitemtypeimagesrc {
487 my $src = shift || 'opac';
488 if ($src eq 'intranet') {
489 return '/intranet-tmpl' . '/' . C4::Context->preference('template') . '/img/itemtypeimg';
490 } else {
491 return '/opac-tmpl' . '/' . C4::Context->preference('opacthemes') . '/itemtypeimg';
495 sub getitemtypeimagelocation {
496 my ( $src, $image ) = @_;
498 return '' if ( !$image );
499 require URI::Split;
501 my $scheme = ( URI::Split::uri_split( $image ) )[0];
503 return $image if ( $scheme );
505 return getitemtypeimagesrc( $src ) . '/' . $image;
508 =head3 _getImagesFromDirectory
510 Find all of the image files in a directory in the filesystem
512 parameters: a directory name
514 returns: a list of images in that directory.
516 Notes: this does not traverse into subdirectories. See
517 _getSubdirectoryNames for help with that.
518 Images are assumed to be files with .gif or .png file extensions.
519 The image names returned do not have the directory name on them.
521 =cut
523 sub _getImagesFromDirectory {
524 my $directoryname = shift;
525 return unless defined $directoryname;
526 return unless -d $directoryname;
528 if ( opendir ( my $dh, $directoryname ) ) {
529 my @images = grep { /\.(gif|png)$/i } readdir( $dh );
530 closedir $dh;
531 @images = sort(@images);
532 return @images;
533 } else {
534 warn "unable to opendir $directoryname: $!";
535 return;
539 =head3 _getSubdirectoryNames
541 Find all of the directories in a directory in the filesystem
543 parameters: a directory name
545 returns: a list of subdirectories in that directory.
547 Notes: this does not traverse into subdirectories. Only the first
548 level of subdirectories are returned.
549 The directory names returned don't have the parent directory name on them.
551 =cut
553 sub _getSubdirectoryNames {
554 my $directoryname = shift;
555 return unless defined $directoryname;
556 return unless -d $directoryname;
558 if ( opendir ( my $dh, $directoryname ) ) {
559 my @directories = grep { -d File::Spec->catfile( $directoryname, $_ ) && ! ( /^\./ ) } readdir( $dh );
560 closedir $dh;
561 return @directories;
562 } else {
563 warn "unable to opendir $directoryname: $!";
564 return;
568 =head3 getImageSets
570 returns: a listref of hashrefs. Each hash represents another collection of images.
572 { imagesetname => 'npl', # the name of the image set (npl is the original one)
573 images => listref of image hashrefs
576 each image is represented by a hashref like this:
578 { KohaImage => 'npl/image.gif',
579 StaffImageUrl => '/intranet-tmpl/prog/img/itemtypeimg/npl/image.gif',
580 OpacImageURL => '/opac-tmpl/prog/itemtypeimg/npl/image.gif'
581 checked => 0 or 1: was this the image passed to this method?
582 Note: I'd like to remove this somehow.
585 =cut
587 sub getImageSets {
588 my %params = @_;
589 my $checked = $params{'checked'} || '';
591 my $paths = { staff => { filesystem => getitemtypeimagedir('intranet'),
592 url => getitemtypeimagesrc('intranet'),
594 opac => { filesystem => getitemtypeimagedir('opac'),
595 url => getitemtypeimagesrc('opac'),
599 my @imagesets = (); # list of hasrefs of image set data to pass to template
600 my @subdirectories = _getSubdirectoryNames( $paths->{'staff'}{'filesystem'} );
601 foreach my $imagesubdir ( @subdirectories ) {
602 warn $imagesubdir if $DEBUG;
603 my @imagelist = (); # hashrefs of image info
604 my @imagenames = _getImagesFromDirectory( File::Spec->catfile( $paths->{'staff'}{'filesystem'}, $imagesubdir ) );
605 my $imagesetactive = 0;
606 foreach my $thisimage ( @imagenames ) {
607 push( @imagelist,
608 { KohaImage => "$imagesubdir/$thisimage",
609 StaffImageUrl => join( '/', $paths->{'staff'}{'url'}, $imagesubdir, $thisimage ),
610 OpacImageUrl => join( '/', $paths->{'opac'}{'url'}, $imagesubdir, $thisimage ),
611 checked => "$imagesubdir/$thisimage" eq $checked ? 1 : 0,
614 $imagesetactive = 1 if "$imagesubdir/$thisimage" eq $checked;
616 push @imagesets, { imagesetname => $imagesubdir,
617 imagesetactive => $imagesetactive,
618 images => \@imagelist };
621 return \@imagesets;
624 =head2 GetPrinters
626 $printers = &GetPrinters();
627 @queues = keys %$printers;
629 Returns information about existing printer queues.
631 C<$printers> is a reference-to-hash whose keys are the print queues
632 defined in the printers table of the Koha database. The values are
633 references-to-hash, whose keys are the fields in the printers table.
635 =cut
637 sub GetPrinters {
638 my %printers;
639 my $dbh = C4::Context->dbh;
640 my $sth = $dbh->prepare("select * from printers");
641 $sth->execute;
642 while ( my $printer = $sth->fetchrow_hashref ) {
643 $printers{ $printer->{'printqueue'} } = $printer;
645 return ( \%printers );
648 =head2 GetPrinter
650 $printer = GetPrinter( $query, $printers );
652 =cut
654 sub GetPrinter {
655 my ( $query, $printers ) = @_; # get printer for this query from printers
656 my $printer = $query->param('printer');
657 my %cookie = $query->cookie('userenv');
658 ($printer) || ( $printer = $cookie{'printer'} ) || ( $printer = '' );
659 ( $printers->{$printer} ) || ( $printer = ( keys %$printers )[0] );
660 return $printer;
663 =head2 getnbpages
665 Returns the number of pages to display in a pagination bar, given the number
666 of items and the number of items per page.
668 =cut
670 sub getnbpages {
671 my ( $nb_items, $nb_items_per_page ) = @_;
673 return int( ( $nb_items - 1 ) / $nb_items_per_page ) + 1;
676 =head2 getallthemes
678 (@themes) = &getallthemes('opac');
679 (@themes) = &getallthemes('intranet');
681 Returns an array of all available themes.
683 =cut
685 sub getallthemes {
686 my $type = shift;
687 my $htdocs;
688 my @themes;
689 if ( $type eq 'intranet' ) {
690 $htdocs = C4::Context->config('intrahtdocs');
692 else {
693 $htdocs = C4::Context->config('opachtdocs');
695 opendir D, "$htdocs";
696 my @dirlist = readdir D;
697 foreach my $directory (@dirlist) {
698 next if $directory eq 'lib';
699 -d "$htdocs/$directory/en" and push @themes, $directory;
701 return @themes;
704 sub getFacets {
705 my $facets;
706 if ( C4::Context->preference("marcflavour") eq "UNIMARC" ) {
707 $facets = [
709 idx => 'su-to',
710 label => 'Topics',
711 tags => [ qw/ 600ab 601ab 602a 604at 605a 606ax 610a / ],
712 sep => ' - ',
715 idx => 'su-geo',
716 label => 'Places',
717 tags => [ qw/ 607a / ],
718 sep => ' - ',
721 idx => 'su-ut',
722 label => 'Titles',
723 tags => [ qw/ 500a 501a 503a / ],
724 sep => ', ',
727 idx => 'au',
728 label => 'Authors',
729 tags => [ qw/ 700ab 701ab 702ab / ],
730 sep => C4::Context->preference("UNIMARCAuthorsFacetsSeparator"),
733 idx => 'se',
734 label => 'Series',
735 tags => [ qw/ 225a / ],
736 sep => ', ',
739 idx => 'location',
740 label => 'Location',
741 tags => [ qw/ 995e / ],
745 unless ( Koha::Libraries->search->count == 1 )
747 my $DisplayLibraryFacets = C4::Context->preference('DisplayLibraryFacets');
748 if ( $DisplayLibraryFacets eq 'both'
749 || $DisplayLibraryFacets eq 'holding' )
751 push(
752 @$facets,
754 idx => 'holdingbranch',
755 label => 'HoldingLibrary',
756 tags => [qw / 995c /],
761 if ( $DisplayLibraryFacets eq 'both'
762 || $DisplayLibraryFacets eq 'home' )
764 push(
765 @$facets,
767 idx => 'homebranch',
768 label => 'HomeLibrary',
769 tags => [qw / 995b /],
775 else {
776 $facets = [
778 idx => 'su-to',
779 label => 'Topics',
780 tags => [ qw/ 650a / ],
781 sep => '--',
784 # idx => 'su-na',
785 # label => 'People and Organizations',
786 # tags => [ qw/ 600a 610a 611a / ],
787 # sep => 'a',
788 # },
790 idx => 'su-geo',
791 label => 'Places',
792 tags => [ qw/ 651a / ],
793 sep => '--',
796 idx => 'su-ut',
797 label => 'Titles',
798 tags => [ qw/ 630a / ],
799 sep => '--',
802 idx => 'au',
803 label => 'Authors',
804 tags => [ qw/ 100a 110a 700a / ],
805 sep => ', ',
808 idx => 'se',
809 label => 'Series',
810 tags => [ qw/ 440a 490a / ],
811 sep => ', ',
814 idx => 'itype',
815 label => 'ItemTypes',
816 tags => [ qw/ 952y 942c / ],
817 sep => ', ',
820 idx => 'location',
821 label => 'Location',
822 tags => [ qw / 952c / ],
826 unless ( Koha::Libraries->search->count == 1 )
828 my $DisplayLibraryFacets = C4::Context->preference('DisplayLibraryFacets');
829 if ( $DisplayLibraryFacets eq 'both'
830 || $DisplayLibraryFacets eq 'holding' )
832 push(
833 @$facets,
835 idx => 'holdingbranch',
836 label => 'HoldingLibrary',
837 tags => [qw / 952b /],
842 if ( $DisplayLibraryFacets eq 'both'
843 || $DisplayLibraryFacets eq 'home' )
845 push(
846 @$facets,
848 idx => 'homebranch',
849 label => 'HomeLibrary',
850 tags => [qw / 952a /],
856 return $facets;
859 =head2 get_infos_of
861 Return a href where a key is associated to a href. You give a query,
862 the name of the key among the fields returned by the query. If you
863 also give as third argument the name of the value, the function
864 returns a href of scalar. The optional 4th argument is an arrayref of
865 items passed to the C<execute()> call. It is designed to bind
866 parameters to any placeholders in your SQL.
868 my $query = '
869 SELECT itemnumber,
870 notforloan,
871 barcode
872 FROM items
875 # generic href of any information on the item, href of href.
876 my $iteminfos_of = get_infos_of($query, 'itemnumber');
877 print $iteminfos_of->{$itemnumber}{barcode};
879 # specific information, href of scalar
880 my $barcode_of_item = get_infos_of($query, 'itemnumber', 'barcode');
881 print $barcode_of_item->{$itemnumber};
883 =cut
885 sub get_infos_of {
886 my ( $query, $key_name, $value_name, $bind_params ) = @_;
888 my $dbh = C4::Context->dbh;
890 my $sth = $dbh->prepare($query);
891 $sth->execute( @$bind_params );
893 my %infos_of;
894 while ( my $row = $sth->fetchrow_hashref ) {
895 if ( defined $value_name ) {
896 $infos_of{ $row->{$key_name} } = $row->{$value_name};
898 else {
899 $infos_of{ $row->{$key_name} } = $row;
902 $sth->finish;
904 return \%infos_of;
907 =head2 get_notforloan_label_of
909 my $notforloan_label_of = get_notforloan_label_of();
911 Each authorised value of notforloan (information available in items and
912 itemtypes) is link to a single label.
914 Returns a href where keys are authorised values and values are corresponding
915 labels.
917 foreach my $authorised_value (keys %{$notforloan_label_of}) {
918 printf(
919 "authorised_value: %s => %s\n",
920 $authorised_value,
921 $notforloan_label_of->{$authorised_value}
925 =cut
927 # FIXME - why not use GetAuthorisedValues ??
929 sub get_notforloan_label_of {
930 my $dbh = C4::Context->dbh;
932 my $query = '
933 SELECT authorised_value
934 FROM marc_subfield_structure
935 WHERE kohafield = \'items.notforloan\'
936 LIMIT 0, 1
938 my $sth = $dbh->prepare($query);
939 $sth->execute();
940 my ($statuscode) = $sth->fetchrow_array();
942 $query = '
943 SELECT lib,
944 authorised_value
945 FROM authorised_values
946 WHERE category = ?
948 $sth = $dbh->prepare($query);
949 $sth->execute($statuscode);
950 my %notforloan_label_of;
951 while ( my $row = $sth->fetchrow_hashref ) {
952 $notforloan_label_of{ $row->{authorised_value} } = $row->{lib};
954 $sth->finish;
956 return \%notforloan_label_of;
959 =head2 GetAuthValCode
961 $authvalcode = GetAuthValCode($kohafield,$frameworkcode);
963 =cut
965 sub GetAuthValCode {
966 my ($kohafield,$fwcode) = @_;
967 my $dbh = C4::Context->dbh;
968 $fwcode='' unless $fwcode;
969 my $sth = $dbh->prepare('select authorised_value from marc_subfield_structure where kohafield=? and frameworkcode=?');
970 $sth->execute($kohafield,$fwcode);
971 my ($authvalcode) = $sth->fetchrow_array;
972 return $authvalcode;
975 =head2 GetAuthValCodeFromField
977 $authvalcode = GetAuthValCodeFromField($field,$subfield,$frameworkcode);
979 C<$subfield> can be undefined
981 =cut
983 sub GetAuthValCodeFromField {
984 my ($field,$subfield,$fwcode) = @_;
985 my $dbh = C4::Context->dbh;
986 $fwcode='' unless $fwcode;
987 my $sth;
988 if (defined $subfield) {
989 $sth = $dbh->prepare('select authorised_value from marc_subfield_structure where tagfield=? and tagsubfield=? and frameworkcode=?');
990 $sth->execute($field,$subfield,$fwcode);
991 } else {
992 $sth = $dbh->prepare('select authorised_value from marc_tag_structure where tagfield=? and frameworkcode=?');
993 $sth->execute($field,$fwcode);
995 my ($authvalcode) = $sth->fetchrow_array;
996 return $authvalcode;
999 =head2 GetAuthorisedValues
1001 $authvalues = GetAuthorisedValues([$category]);
1003 This function returns all authorised values from the'authorised_value' table in a reference to array of hashrefs.
1005 C<$category> returns authorised values for just one category (optional).
1007 C<$opac> If set to a true value, displays OPAC descriptions rather than normal ones when they exist.
1009 =cut
1011 sub GetAuthorisedValues {
1012 my ( $category, $opac ) = @_;
1014 # Is this cached already?
1015 $opac = $opac ? 1 : 0; # normalise to be safe
1016 my $branch_limit =
1017 C4::Context->userenv ? C4::Context->userenv->{"branch"} : "";
1018 my $cache_key =
1019 "AuthorisedValues-$category-$opac-$branch_limit";
1020 my $cache = Koha::Cache->get_instance();
1021 my $result = $cache->get_from_cache($cache_key);
1022 return $result if $result;
1024 my @results;
1025 my $dbh = C4::Context->dbh;
1026 my $query = qq{
1027 SELECT DISTINCT av.*
1028 FROM authorised_values av
1030 $query .= qq{
1031 LEFT JOIN authorised_values_branches ON ( id = av_id )
1032 } if $branch_limit;
1033 my @where_strings;
1034 my @where_args;
1035 if($category) {
1036 push @where_strings, "category = ?";
1037 push @where_args, $category;
1039 if($branch_limit) {
1040 push @where_strings, "( branchcode = ? OR branchcode IS NULL )";
1041 push @where_args, $branch_limit;
1043 if(@where_strings > 0) {
1044 $query .= " WHERE " . join(" AND ", @where_strings);
1046 $query .= ' ORDER BY category, ' . (
1047 $opac ? 'COALESCE(lib_opac, lib)'
1048 : 'lib, lib_opac'
1051 my $sth = $dbh->prepare($query);
1053 $sth->execute( @where_args );
1054 while (my $data=$sth->fetchrow_hashref) {
1055 if ($opac && $data->{lib_opac}) {
1056 $data->{lib} = $data->{lib_opac};
1058 push @results, $data;
1060 $sth->finish;
1062 $cache->set_in_cache( $cache_key, \@results, { deepcopy => 1, expiry => 5 } );
1063 return \@results;
1066 =head2 GetAuthorisedValueCategories
1068 $auth_categories = GetAuthorisedValueCategories();
1070 Return an arrayref of all of the available authorised
1071 value categories.
1073 =cut
1075 sub GetAuthorisedValueCategories {
1076 my $dbh = C4::Context->dbh;
1077 my $sth = $dbh->prepare("SELECT DISTINCT category FROM authorised_values ORDER BY category");
1078 $sth->execute;
1079 my @results;
1080 while (defined (my $category = $sth->fetchrow_array) ) {
1081 push @results, $category;
1083 return \@results;
1086 =head2 GetAuthorisedValueByCode
1088 $authorised_value = GetAuthorisedValueByCode( $category, $authvalcode, $opac );
1090 Return the lib attribute from authorised_values from the row identified
1091 by the passed category and code
1093 =cut
1095 sub GetAuthorisedValueByCode {
1096 my ( $category, $authvalcode, $opac ) = @_;
1098 my $field = $opac ? 'lib_opac' : 'lib';
1099 my $dbh = C4::Context->dbh;
1100 my $sth = $dbh->prepare("SELECT $field FROM authorised_values WHERE category=? AND authorised_value =?");
1101 $sth->execute( $category, $authvalcode );
1102 while ( my $data = $sth->fetchrow_hashref ) {
1103 return $data->{ $field };
1107 =head2 GetKohaAuthorisedValues
1109 Takes $kohafield, $fwcode as parameters.
1111 If $opac parameter is set to a true value, displays OPAC descriptions rather than normal ones when they exist.
1113 Returns hashref of Code => description
1115 Returns undef if no authorised value category is defined for the kohafield.
1117 =cut
1119 sub GetKohaAuthorisedValues {
1120 my ($kohafield,$fwcode,$opac) = @_;
1121 $fwcode='' unless $fwcode;
1122 my %values;
1123 my $dbh = C4::Context->dbh;
1124 my $avcode = GetAuthValCode($kohafield,$fwcode);
1125 if ($avcode) {
1126 my $sth = $dbh->prepare("select authorised_value, lib, lib_opac from authorised_values where category=? ");
1127 $sth->execute($avcode);
1128 while ( my ($val, $lib, $lib_opac) = $sth->fetchrow_array ) {
1129 $values{$val} = ($opac && $lib_opac) ? $lib_opac : $lib;
1131 return \%values;
1132 } else {
1133 return;
1137 =head2 GetKohaAuthorisedValuesFromField
1139 Takes $field, $subfield, $fwcode as parameters.
1141 If $opac parameter is set to a true value, displays OPAC descriptions rather than normal ones when they exist.
1142 $subfield can be undefined
1144 Returns hashref of Code => description
1146 Returns undef if no authorised value category is defined for the given field and subfield
1148 =cut
1150 sub GetKohaAuthorisedValuesFromField {
1151 my ($field, $subfield, $fwcode,$opac) = @_;
1152 $fwcode='' unless $fwcode;
1153 my %values;
1154 my $dbh = C4::Context->dbh;
1155 my $avcode = GetAuthValCodeFromField($field, $subfield, $fwcode);
1156 if ($avcode) {
1157 my $sth = $dbh->prepare("select authorised_value, lib, lib_opac from authorised_values where category=? ");
1158 $sth->execute($avcode);
1159 while ( my ($val, $lib, $lib_opac) = $sth->fetchrow_array ) {
1160 $values{$val} = ($opac && $lib_opac) ? $lib_opac : $lib;
1162 return \%values;
1163 } else {
1164 return;
1168 =head2 GetKohaAuthorisedValuesMapping
1170 Takes a hash as a parameter. The interface key indicates the
1171 description to use in the mapping.
1173 Returns hashref of:
1174 "{kohafield},{frameworkcode},{authorised_value}" => "{description}"
1175 for all the kohafields, frameworkcodes, and authorised values.
1177 Returns undef if nothing is found.
1179 =cut
1181 sub GetKohaAuthorisedValuesMapping {
1182 my ($parameter) = @_;
1183 my $interface = $parameter->{'interface'} // '';
1185 my $query_mapping = q{
1186 SELECT TA.kohafield,TA.authorised_value AS category,
1187 TA.frameworkcode,TB.authorised_value,
1188 IF(TB.lib_opac>'',TB.lib_opac,TB.lib) AS OPAC,
1189 TB.lib AS Intranet,TB.lib_opac
1190 FROM marc_subfield_structure AS TA JOIN
1191 authorised_values as TB ON
1192 TA.authorised_value=TB.category
1193 WHERE TA.kohafield>'' AND TA.authorised_value>'';
1195 my $dbh = C4::Context->dbh;
1196 my $sth = $dbh->prepare($query_mapping);
1197 $sth->execute();
1198 my $avmapping;
1199 if ($interface eq 'opac') {
1200 while (my $row = $sth->fetchrow_hashref) {
1201 $avmapping->{$row->{kohafield}.",".$row->{frameworkcode}.",".$row->{authorised_value}} = $row->{OPAC};
1204 else {
1205 while (my $row = $sth->fetchrow_hashref) {
1206 $avmapping->{$row->{kohafield}.",".$row->{frameworkcode}.",".$row->{authorised_value}} = $row->{Intranet};
1209 return $avmapping;
1212 =head2 xml_escape
1214 my $escaped_string = C4::Koha::xml_escape($string);
1216 Convert &, <, >, ', and " in a string to XML entities
1218 =cut
1220 sub xml_escape {
1221 my $str = shift;
1222 return '' unless defined $str;
1223 $str =~ s/&/&amp;/g;
1224 $str =~ s/</&lt;/g;
1225 $str =~ s/>/&gt;/g;
1226 $str =~ s/'/&apos;/g;
1227 $str =~ s/"/&quot;/g;
1228 return $str;
1231 =head2 GetKohaAuthorisedValueLib
1233 Takes $category, $authorised_value as parameters.
1235 If $opac parameter is set to a true value, displays OPAC descriptions rather than normal ones when they exist.
1237 Returns authorised value description
1239 =cut
1241 sub GetKohaAuthorisedValueLib {
1242 my ($category,$authorised_value,$opac) = @_;
1243 my $value;
1244 my $dbh = C4::Context->dbh;
1245 my $sth = $dbh->prepare("select lib, lib_opac from authorised_values where category=? and authorised_value=?");
1246 $sth->execute($category,$authorised_value);
1247 my $data = $sth->fetchrow_hashref;
1248 $value = ($opac && $$data{'lib_opac'}) ? $$data{'lib_opac'} : $$data{'lib'};
1249 return $value;
1252 =head2 display_marc_indicators
1254 my $display_form = C4::Koha::display_marc_indicators($field);
1256 C<$field> is a MARC::Field object
1258 Generate a display form of the indicators of a variable
1259 MARC field, replacing any blanks with '#'.
1261 =cut
1263 sub display_marc_indicators {
1264 my $field = shift;
1265 my $indicators = '';
1266 if ($field && $field->tag() >= 10) {
1267 $indicators = $field->indicator(1) . $field->indicator(2);
1268 $indicators =~ s/ /#/g;
1270 return $indicators;
1273 sub GetNormalizedUPC {
1274 my ($marcrecord,$marcflavour) = @_;
1276 return unless $marcrecord;
1277 if ($marcflavour eq 'UNIMARC') {
1278 my @fields = $marcrecord->field('072');
1279 foreach my $field (@fields) {
1280 my $upc = _normalize_match_point($field->subfield('a'));
1281 if ($upc) {
1282 return $upc;
1287 else { # assume marc21 if not unimarc
1288 my @fields = $marcrecord->field('024');
1289 foreach my $field (@fields) {
1290 my $indicator = $field->indicator(1);
1291 my $upc = _normalize_match_point($field->subfield('a'));
1292 if ($upc && $indicator == 1 ) {
1293 return $upc;
1299 # Normalizes and returns the first valid ISBN found in the record
1300 # ISBN13 are converted into ISBN10. This is required to get some book cover images.
1301 sub GetNormalizedISBN {
1302 my ($isbn,$marcrecord,$marcflavour) = @_;
1303 if ($isbn) {
1304 # Koha attempts to store multiple ISBNs in biblioitems.isbn, separated by " | "
1305 # anything after " | " should be removed, along with the delimiter
1306 ($isbn) = split(/\|/, $isbn );
1307 return _isbn_cleanup($isbn);
1310 return unless $marcrecord;
1312 if ($marcflavour eq 'UNIMARC') {
1313 my @fields = $marcrecord->field('010');
1314 foreach my $field (@fields) {
1315 my $isbn = $field->subfield('a');
1316 if ($isbn) {
1317 return _isbn_cleanup($isbn);
1321 else { # assume marc21 if not unimarc
1322 my @fields = $marcrecord->field('020');
1323 foreach my $field (@fields) {
1324 $isbn = $field->subfield('a');
1325 if ($isbn) {
1326 return _isbn_cleanup($isbn);
1332 sub GetNormalizedEAN {
1333 my ($marcrecord,$marcflavour) = @_;
1335 return unless $marcrecord;
1337 if ($marcflavour eq 'UNIMARC') {
1338 my @fields = $marcrecord->field('073');
1339 foreach my $field (@fields) {
1340 my $ean = _normalize_match_point($field->subfield('a'));
1341 if ( $ean ) {
1342 return $ean;
1346 else { # assume marc21 if not unimarc
1347 my @fields = $marcrecord->field('024');
1348 foreach my $field (@fields) {
1349 my $indicator = $field->indicator(1);
1350 my $ean = _normalize_match_point($field->subfield('a'));
1351 if ( $ean && $indicator == 3 ) {
1352 return $ean;
1358 sub GetNormalizedOCLCNumber {
1359 my ($marcrecord,$marcflavour) = @_;
1360 return unless $marcrecord;
1362 if ($marcflavour ne 'UNIMARC' ) {
1363 my @fields = $marcrecord->field('035');
1364 foreach my $field (@fields) {
1365 my $oclc = $field->subfield('a');
1366 if ($oclc =~ /OCoLC/) {
1367 $oclc =~ s/\(OCoLC\)//;
1368 return $oclc;
1371 } else {
1372 # TODO for UNIMARC
1374 return
1377 sub GetAuthvalueDropbox {
1378 my ( $authcat, $default ) = @_;
1379 my $branch_limit = C4::Context->userenv ? C4::Context->userenv->{"branch"} : "";
1380 my $dbh = C4::Context->dbh;
1382 my $query = qq{
1383 SELECT *
1384 FROM authorised_values
1386 $query .= qq{
1387 LEFT JOIN authorised_values_branches ON ( id = av_id )
1388 } if $branch_limit;
1389 $query .= qq{
1390 WHERE category = ?
1392 $query .= " AND ( branchcode = ? OR branchcode IS NULL )" if $branch_limit;
1393 $query .= " GROUP BY lib ORDER BY category, lib, lib_opac";
1394 my $sth = $dbh->prepare($query);
1395 $sth->execute( $authcat, $branch_limit ? $branch_limit : () );
1398 my $option_list = [];
1399 my @authorised_values = ( q{} );
1400 while (my $av = $sth->fetchrow_hashref) {
1401 push @{$option_list}, {
1402 value => $av->{authorised_value},
1403 label => $av->{lib},
1404 default => ($default eq $av->{authorised_value}),
1408 if ( @{$option_list} ) {
1409 return $option_list;
1411 return;
1415 =head2 GetDailyQuote($opts)
1417 Takes a hashref of options
1419 Currently supported options are:
1421 'id' An exact quote id
1422 'random' Select a random quote
1423 noop When no option is passed in, this sub will return the quote timestamped for the current day
1425 The function returns an anonymous hash following this format:
1428 'source' => 'source-of-quote',
1429 'timestamp' => 'timestamp-value',
1430 'text' => 'text-of-quote',
1431 'id' => 'quote-id'
1434 =cut
1436 # This is definitely a candidate for some sort of caching once we finally settle caching/persistence issues...
1437 # at least for default option
1439 sub GetDailyQuote {
1440 my %opts = @_;
1441 my $dbh = C4::Context->dbh;
1442 my $query = '';
1443 my $sth = undef;
1444 my $quote = undef;
1445 if ($opts{'id'}) {
1446 $query = 'SELECT * FROM quotes WHERE id = ?';
1447 $sth = $dbh->prepare($query);
1448 $sth->execute($opts{'id'});
1449 $quote = $sth->fetchrow_hashref();
1451 elsif ($opts{'random'}) {
1452 # Fall through... we also return a random quote as a catch-all if all else fails
1454 else {
1455 $query = 'SELECT * FROM quotes WHERE timestamp LIKE CONCAT(CURRENT_DATE,\'%\') ORDER BY timestamp DESC LIMIT 0,1';
1456 $sth = $dbh->prepare($query);
1457 $sth->execute();
1458 $quote = $sth->fetchrow_hashref();
1460 unless ($quote) { # if there are not matches, choose a random quote
1461 # get a list of all available quote ids
1462 $sth = C4::Context->dbh->prepare('SELECT count(*) FROM quotes;');
1463 $sth->execute;
1464 my $range = ($sth->fetchrow_array)[0];
1465 # chose a random id within that range if there is more than one quote
1466 my $offset = int(rand($range));
1467 # grab it
1468 $query = 'SELECT * FROM quotes ORDER BY id LIMIT 1 OFFSET ?';
1469 $sth = C4::Context->dbh->prepare($query);
1470 # see http://www.perlmonks.org/?node_id=837422 for why
1471 # we're being verbose and using bind_param
1472 $sth->bind_param(1, $offset, SQL_INTEGER);
1473 $sth->execute();
1474 $quote = $sth->fetchrow_hashref();
1475 # update the timestamp for that quote
1476 $query = 'UPDATE quotes SET timestamp = ? WHERE id = ?';
1477 $sth = C4::Context->dbh->prepare($query);
1478 $sth->execute(
1479 DateTime::Format::MySQL->format_datetime( dt_from_string() ),
1480 $quote->{'id'}
1483 return $quote;
1486 sub _normalize_match_point {
1487 my $match_point = shift;
1488 (my $normalized_match_point) = $match_point =~ /([\d-]*[X]*)/;
1489 $normalized_match_point =~ s/-//g;
1491 return $normalized_match_point;
1494 sub _isbn_cleanup {
1495 my ($isbn) = @_;
1496 return NormalizeISBN(
1498 isbn => $isbn,
1499 format => 'ISBN-10',
1500 strip_hyphens => 1,
1502 ) if $isbn;
1505 =head2 NormalizedISBN
1507 my $isbns = NormalizedISBN({
1508 isbn => $isbn,
1509 strip_hyphens => [0,1],
1510 format => ['ISBN-10', 'ISBN-13']
1513 Returns an isbn validated by Business::ISBN.
1514 Optionally strips hyphens and/or forces the isbn
1515 to be of the specified format.
1517 If the string cannot be validated as an isbn,
1518 it returns nothing.
1520 =cut
1522 sub NormalizeISBN {
1523 my ($params) = @_;
1525 my $string = $params->{isbn};
1526 my $strip_hyphens = $params->{strip_hyphens};
1527 my $format = $params->{format};
1529 return unless $string;
1531 my $isbn = Business::ISBN->new($string);
1533 if ( $isbn && $isbn->is_valid() ) {
1535 if ( $format eq 'ISBN-10' ) {
1536 $isbn = $isbn->as_isbn10();
1538 elsif ( $format eq 'ISBN-13' ) {
1539 $isbn = $isbn->as_isbn13();
1541 return unless $isbn;
1543 if ($strip_hyphens) {
1544 $string = $isbn->as_string( [] );
1545 } else {
1546 $string = $isbn->as_string();
1549 return $string;
1553 =head2 GetVariationsOfISBN
1555 my @isbns = GetVariationsOfISBN( $isbn );
1557 Returns a list of variations of the given isbn in
1558 both ISBN-10 and ISBN-13 formats, with and without
1559 hyphens.
1561 In a scalar context, the isbns are returned as a
1562 string delimited by ' | '.
1564 =cut
1566 sub GetVariationsOfISBN {
1567 my ($isbn) = @_;
1569 return unless $isbn;
1571 my @isbns;
1573 push( @isbns, NormalizeISBN({ isbn => $isbn }) );
1574 push( @isbns, NormalizeISBN({ isbn => $isbn, format => 'ISBN-10' }) );
1575 push( @isbns, NormalizeISBN({ isbn => $isbn, format => 'ISBN-13' }) );
1576 push( @isbns, NormalizeISBN({ isbn => $isbn, format => 'ISBN-10', strip_hyphens => 1 }) );
1577 push( @isbns, NormalizeISBN({ isbn => $isbn, format => 'ISBN-13', strip_hyphens => 1 }) );
1579 # Strip out any "empty" strings from the array
1580 @isbns = grep { defined($_) && $_ =~ /\S/ } @isbns;
1582 return wantarray ? @isbns : join( " | ", @isbns );
1585 =head2 GetVariationsOfISBNs
1587 my @isbns = GetVariationsOfISBNs( @isbns );
1589 Returns a list of variations of the given isbns in
1590 both ISBN-10 and ISBN-13 formats, with and without
1591 hyphens.
1593 In a scalar context, the isbns are returned as a
1594 string delimited by ' | '.
1596 =cut
1598 sub GetVariationsOfISBNs {
1599 my (@isbns) = @_;
1601 @isbns = map { GetVariationsOfISBN( $_ ) } @isbns;
1603 return wantarray ? @isbns : join( " | ", @isbns );
1606 =head2 IsKohaFieldLinked
1608 my $is_linked = IsKohaFieldLinked({
1609 kohafield => $kohafield,
1610 frameworkcode => $frameworkcode,
1613 Return 1 if the field is linked
1615 =cut
1617 sub IsKohaFieldLinked {
1618 my ( $params ) = @_;
1619 my $kohafield = $params->{kohafield};
1620 my $frameworkcode = $params->{frameworkcode} || '';
1621 my $dbh = C4::Context->dbh;
1622 my $is_linked = $dbh->selectcol_arrayref( q|
1623 SELECT COUNT(*)
1624 FROM marc_subfield_structure
1625 WHERE frameworkcode = ?
1626 AND kohafield = ?
1627 |,{}, $frameworkcode, $kohafield );
1628 return $is_linked->[0];
1633 __END__
1635 =head1 AUTHOR
1637 Koha Team
1639 =cut