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>.
24 #use warnings; FIXME - Bug 2505
27 use C4
::Branch
qw(GetBranchesCount);
29 use Koha
::DateUtils
qw(dt_from_string);
30 use DateTime
::Format
::MySQL
;
32 use autouse
'Data::cselectall_arrayref' => qw(Dumper);
33 use DBI
qw(:sql_types);
34 use vars
qw($VERSION @ISA @EXPORT @EXPORT_OK $DEBUG);
37 $VERSION = 3.07.00.049;
42 &subfield_is_koha_internal_p
43 &GetPrinters &GetPrinter
44 &GetItemTypes &getitemtypeinfo
45 &GetItemTypesCategorized &GetItemTypesByCategory
46 &GetSupportName &GetSupportList
48 &getframeworks &getframeworkinfo
50 &getauthtypes &getauthtype
56 &get_notforloan_label_of
59 &getitemtypeimagelocation
61 &GetAuthorisedValueCategories
62 &IsAuthorisedValueCategory
63 &GetKohaAuthorisedValues
64 &GetKohaAuthorisedValuesFromField
65 &GetKohaAuthorisedValuesMapping
66 &GetKohaAuthorisedValueLib
67 &GetAuthorisedValueByCode
68 &GetKohaImageurlFromAuthorisedValues
74 &GetNormalizedOCLCNumber
84 @EXPORT_OK = qw( GetDailyQuote );
89 C4::Koha - Perl Module containing convenience functions for Koha scripts
97 Koha.pm provides many functions for Koha scripts.
105 $slash_date = &slashifyDate($dash_date);
107 Takes a string of the form "DD-MM-YYYY" (or anything separated by
108 dashes), converts it to the form "YYYY/MM/DD", and returns the result.
114 # accepts a date of the form xx-xx-xx[xx] and returns it in the
116 my @dateOut = split( '-', shift );
117 return ("$dateOut[2]/$dateOut[1]/$dateOut[0]");
120 # FIXME.. this should be moved to a MARC-specific module
121 sub subfield_is_koha_internal_p
{
124 # We could match on 'lib' and 'tab' (and 'mandatory', & more to come!)
125 # But real MARC subfields are always single-character
126 # so it really is safer just to check the length
128 return length $subfield != 1;
131 =head2 GetSupportName
133 $itemtypename = &GetSupportName($codestring);
135 Returns a string with the name of the itemtype.
141 return if (! $codestring);
143 my $advanced_search_types = C4
::Context
->preference("AdvancedSearchTypes");
144 if (!$advanced_search_types or $advanced_search_types eq 'itemtypes') {
151 my $sth = C4
::Context
->dbh->prepare($query);
152 $sth->execute($codestring);
153 ($resultstring)=$sth->fetchrow;
154 return $resultstring;
157 C4
::Context
->dbh->prepare(
158 "SELECT lib FROM authorised_values WHERE category = ? AND authorised_value = ?"
160 $sth->execute( $advanced_search_types, $codestring );
161 my $data = $sth->fetchrow_hashref;
162 return $$data{'lib'};
166 =head2 GetSupportList
168 $itemtypes = &GetSupportList();
170 Returns an array ref containing informations about Support (since itemtype is rather a circulation code when item-level-itypes is used).
172 build a HTML select with the following code :
174 =head3 in PERL SCRIPT
176 my $itemtypes = GetSupportList();
177 $template->param(itemtypeloop => $itemtypes);
181 <select name="itemtype" id="itemtype">
182 <option value=""></option>
183 [% FOREACH itemtypeloo IN itemtypeloop %]
184 [% IF ( itemtypeloo.selected ) %]
185 <option value="[% itemtypeloo.itemtype %]" selected="selected">[% itemtypeloo.description %]</option>
187 <option value="[% itemtypeloo.itemtype %]">[% itemtypeloo.description %]</option>
195 my $advanced_search_types = C4
::Context
->preference("AdvancedSearchTypes");
196 if (!$advanced_search_types or $advanced_search_types =~ /itemtypes/) {
197 return GetItemTypes
( style
=> 'array' );
199 my $advsearchtypes = GetAuthorisedValues
($advanced_search_types);
200 my @results= map {{itemtype
=>$$_{authorised_value
},description
=>$$_{lib
},imageurl
=>$$_{imageurl
}}} @
$advsearchtypes;
206 $itemtypes = &GetItemTypes( style => $style );
208 Returns information about existing itemtypes.
211 style: either 'array' or 'hash', defaults to 'hash'.
212 'array' returns an arrayref,
213 'hash' return a hashref with the itemtype value as the key
215 build a HTML select with the following code :
217 =head3 in PERL SCRIPT
219 my $itemtypes = GetItemTypes;
221 foreach my $thisitemtype (sort keys %$itemtypes) {
222 my $selected = 1 if $thisitemtype eq $itemtype;
223 my %row =(value => $thisitemtype,
224 selected => $selected,
225 description => $itemtypes->{$thisitemtype}->{'description'},
227 push @itemtypesloop, \%row;
229 $template->param(itemtypeloop => \@itemtypesloop);
233 <form action='<!-- TMPL_VAR name="script_name" -->' method=post>
234 <select name="itemtype">
235 <option value="">Default</option>
236 <!-- TMPL_LOOP name="itemtypeloop" -->
237 <option value="<!-- TMPL_VAR name="value" -->" <!-- TMPL_IF name="selected" -->selected<!-- /TMPL_IF -->><!-- TMPL_VAR name="description" --></option>
240 <input type=text name=searchfield value="<!-- TMPL_VAR name="searchfield" -->">
241 <input type="submit" value="OK" class="button">
248 my $style = defined( $params{'style'} ) ?
$params{'style'} : 'hash';
250 require C4
::Languages
;
251 my $language = C4
::Languages
::getlanguage
();
252 # returns a reference to a hash of references to itemtypes...
254 my $dbh = C4
::Context
->dbh;
258 itemtypes
.description
,
259 itemtypes
.rentalcharge
,
260 itemtypes
.notforloan
,
263 itemtypes
.checkinmsg
,
264 itemtypes
.checkinmsgtype
,
265 itemtypes
.sip_media_type
,
266 COALESCE
( localization
.translation
, itemtypes
.description
) AS translated_description
268 LEFT JOIN localization ON itemtypes
.itemtype
= localization
.code
269 AND localization
.entity
= 'itemtypes'
270 AND localization
.lang
= ?
273 my $sth = $dbh->prepare($query);
274 $sth->execute( $language );
276 if ( $style eq 'hash' ) {
277 while ( my $IT = $sth->fetchrow_hashref ) {
278 $itemtypes{ $IT->{'itemtype'} } = $IT;
280 return ( \
%itemtypes );
282 return $sth->fetchall_arrayref({});
286 =head2 GetItemTypesCategorized
288 $categories = GetItemTypesCategorized();
290 Returns a hashref containing search categories.
291 A search category will be put in the hash if at least one of its itemtypes is visible in OPAC.
292 The categories must be part of Authorized Values (ITEMTYPECAT)
296 sub GetItemTypesCategorized
{
297 my $dbh = C4
::Context
->dbh;
298 # Order is important, so that partially hidden (some items are not visible in OPAC) search
299 # categories will be visible. hideinopac=0 must be last.
301 SELECT itemtype
, description
, imageurl
, hideinopac
, 0 as
'iscat' FROM itemtypes WHERE ISNULL
(searchcategory
) or length(searchcategory
) = 0
303 SELECT DISTINCT searchcategory AS
`itemtype`,
304 authorised_values
.lib_opac AS description
,
305 authorised_values
.imageurl AS imageurl
,
306 hideinopac
, 1 as
'iscat'
308 LEFT JOIN authorised_values ON searchcategory
= authorised_value
309 WHERE searchcategory
> '' and hideinopac
=1
311 SELECT DISTINCT searchcategory AS
`itemtype`,
312 authorised_values
.lib_opac AS description
,
313 authorised_values
.imageurl AS imageurl
,
314 hideinopac
, 1 as
'iscat'
316 LEFT JOIN authorised_values ON searchcategory
= authorised_value
317 WHERE searchcategory
> '' and hideinopac
=0
319 return ($dbh->selectall_hashref($query,'itemtype'));
322 =head2 GetItemTypesByCategory
324 @results = GetItemTypesByCategory( $searchcategory );
326 Returns the itemtype code of all itemtypes included in a searchcategory.
330 sub GetItemTypesByCategory
{
334 my $dbh = C4
::Context
->dbh;
335 my $query = qq|SELECT itemtype FROM itemtypes WHERE searchcategory
=?
|;
336 my $tmp=$dbh->selectcol_arrayref($query,undef,$category);
340 sub get_itemtypeinfos_of
{
343 my $placeholders = join( ', ', map { '?' } @itemtypes );
344 my $query = <<"END_SQL";
350 WHERE itemtype IN ( $placeholders )
353 return get_infos_of( $query, 'itemtype', undef, \@itemtypes );
358 $authtypes = &getauthtypes();
360 Returns information about existing authtypes.
362 build a HTML select with the following code :
364 =head3 in PERL SCRIPT
366 my $authtypes = getauthtypes;
368 foreach my $thisauthtype (keys %$authtypes) {
369 my $selected = 1 if $thisauthtype eq $authtype;
370 my %row =(value => $thisauthtype,
371 selected => $selected,
372 authtypetext => $authtypes->{$thisauthtype}->{'authtypetext'},
374 push @authtypesloop, \%row;
376 $template->param(itemtypeloop => \@itemtypesloop);
380 <form action='<!-- TMPL_VAR name="script_name" -->' method=post>
381 <select name="authtype">
382 <!-- TMPL_LOOP name="authtypeloop" -->
383 <option value="<!-- TMPL_VAR name="value" -->" <!-- TMPL_IF name="selected" -->selected<!-- /TMPL_IF -->><!-- TMPL_VAR name="authtypetext" --></option>
386 <input type=text name=searchfield value="<!-- TMPL_VAR name="searchfield" -->">
387 <input type="submit" value="OK" class="button">
395 # returns a reference to a hash of references to authtypes...
397 my $dbh = C4::Context->dbh;
398 my $sth = $dbh->prepare("select * from auth_types order by authtypetext");
400 while ( my $IT = $sth->fetchrow_hashref ) {
401 $authtypes{ $IT->{'authtypecode'} } = $IT;
403 return ( \%authtypes );
407 my ($authtypecode) = @_;
409 # returns a reference to a hash of references to authtypes...
411 my $dbh = C4::Context->dbh;
412 my $sth = $dbh->prepare("select * from auth_types where authtypecode=?");
413 $sth->execute($authtypecode);
414 my $res = $sth->fetchrow_hashref;
420 $frameworks = &getframework();
422 Returns information about existing frameworks
424 build a HTML select with the following code :
426 =head3 in PERL SCRIPT
428 my $frameworks = getframeworks();
430 foreach my $thisframework (keys %$frameworks) {
431 my $selected = 1 if $thisframework eq $frameworkcode;
433 value => $thisframework,
434 selected => $selected,
435 description => $frameworks->{$thisframework}->{'frameworktext'},
437 push @frameworksloop, \%row;
439 $template->param(frameworkloop => \@frameworksloop);
443 <form action="[% script_name %] method=post>
444 <select name="frameworkcode">
445 <option value="">Default</option>
446 [% FOREACH framework IN frameworkloop %]
447 [% IF ( framework.selected ) %]
448 <option value="[% framework.value %]" selected="selected">[% framework.description %]</option>
450 <option value="[% framework.value %]">[% framework.description %]</option>
454 <input type
=text name
=searchfield value
="[% searchfield %]">
455 <input type
="submit" value
="OK" class="button">
462 # returns a reference to a hash of references to branches...
464 my $dbh = C4
::Context
->dbh;
465 my $sth = $dbh->prepare("select * from biblio_framework");
467 while ( my $IT = $sth->fetchrow_hashref ) {
468 $itemtypes{ $IT->{'frameworkcode'} } = $IT;
470 return ( \
%itemtypes );
473 =head2 GetFrameworksLoop
475 $frameworks = GetFrameworksLoop( $frameworkcode );
477 Returns the loop suggested on getframework(), but ordered by framework description.
479 build a HTML select with the following code :
481 =head3 in PERL SCRIPT
483 $template->param( frameworkloop => GetFrameworksLoop( $frameworkcode ) );
487 Same as getframework()
489 <form action="[% script_name %] method=post>
490 <select name="frameworkcode">
491 <option value="">Default</option>
492 [% FOREACH framework IN frameworkloop %]
493 [% IF ( framework.selected ) %]
494 <option value="[% framework.value %]" selected="selected">[% framework.description %]</option>
496 <option value="[% framework.value %]">[% framework.description %]</option>
500 <input type=text name=searchfield value="[% searchfield %]">
501 <input type="submit" value="OK" class="button">
506 sub GetFrameworksLoop
{
507 my $frameworkcode = shift;
508 my $frameworks = getframeworks
();
510 foreach my $thisframework (sort { uc($frameworks->{$a}->{'frameworktext'}) cmp uc($frameworks->{$b}->{'frameworktext'}) } keys %$frameworks) {
511 my $selected = ( $thisframework eq $frameworkcode ) ?
1 : undef;
513 value
=> $thisframework,
514 selected
=> $selected,
515 description
=> $frameworks->{$thisframework}->{'frameworktext'},
517 push @frameworkloop, \
%row;
519 return \
@frameworkloop;
522 =head2 getframeworkinfo
524 $frameworkinfo = &getframeworkinfo($frameworkcode);
526 Returns information about an frameworkcode.
530 sub getframeworkinfo
{
531 my ($frameworkcode) = @_;
532 my $dbh = C4
::Context
->dbh;
534 $dbh->prepare("select * from biblio_framework where frameworkcode=?");
535 $sth->execute($frameworkcode);
536 my $res = $sth->fetchrow_hashref;
540 =head2 getitemtypeinfo
542 $itemtype = &getitemtypeinfo($itemtype, [$interface]);
544 Returns information about an itemtype. The optional $interface argument
545 sets which interface ('opac' or 'intranet') to return the imageurl for.
546 Defaults to intranet.
550 sub getitemtypeinfo
{
551 my ($itemtype, $interface) = @_;
552 my $dbh = C4
::Context
->dbh;
553 require C4
::Languages
;
554 my $language = C4
::Languages
::getlanguage
();
555 my $it = $dbh->selectrow_hashref(q
|
558 itemtypes
.description
,
559 itemtypes
.rentalcharge
,
560 itemtypes
.notforloan
,
563 itemtypes
.checkinmsg
,
564 itemtypes
.checkinmsgtype
,
565 itemtypes
.sip_media_type
,
566 COALESCE
( localization
.translation
, itemtypes
.description
) AS translated_description
568 LEFT JOIN localization ON itemtypes
.itemtype
= localization
.code
569 AND localization
.entity
= 'itemtypes'
570 AND localization
.lang
= ?
571 WHERE itemtypes
.itemtype
= ?
572 |, undef, $language, $itemtype );
574 $it->{imageurl
} = getitemtypeimagelocation
( ( ( defined $interface && $interface eq 'opac' ) ?
'opac' : 'intranet' ), $it->{imageurl
} );
579 =head2 getitemtypeimagedir
581 my $directory = getitemtypeimagedir( 'opac' );
583 pass in 'opac' or 'intranet'. Defaults to 'opac'.
585 returns the full path to the appropriate directory containing images.
589 sub getitemtypeimagedir
{
590 my $src = shift || 'opac';
591 if ($src eq 'intranet') {
592 return C4
::Context
->config('intrahtdocs') . '/' .C4
::Context
->preference('template') . '/img/itemtypeimg';
594 return C4
::Context
->config('opachtdocs') . '/' . C4
::Context
->preference('opacthemes') . '/itemtypeimg';
598 sub getitemtypeimagesrc
{
599 my $src = shift || 'opac';
600 if ($src eq 'intranet') {
601 return '/intranet-tmpl' . '/' . C4
::Context
->preference('template') . '/img/itemtypeimg';
603 return '/opac-tmpl' . '/' . C4
::Context
->preference('opacthemes') . '/itemtypeimg';
607 sub getitemtypeimagelocation
{
608 my ( $src, $image ) = @_;
610 return '' if ( !$image );
613 my $scheme = ( URI
::Split
::uri_split
( $image ) )[0];
615 return $image if ( $scheme );
617 return getitemtypeimagesrc
( $src ) . '/' . $image;
620 =head3 _getImagesFromDirectory
622 Find all of the image files in a directory in the filesystem
624 parameters: a directory name
626 returns: a list of images in that directory.
628 Notes: this does not traverse into subdirectories. See
629 _getSubdirectoryNames for help with that.
630 Images are assumed to be files with .gif or .png file extensions.
631 The image names returned do not have the directory name on them.
635 sub _getImagesFromDirectory
{
636 my $directoryname = shift;
637 return unless defined $directoryname;
638 return unless -d
$directoryname;
640 if ( opendir ( my $dh, $directoryname ) ) {
641 my @images = grep { /\.(gif|png)$/i } readdir( $dh );
643 @images = sort(@images);
646 warn "unable to opendir $directoryname: $!";
651 =head3 _getSubdirectoryNames
653 Find all of the directories in a directory in the filesystem
655 parameters: a directory name
657 returns: a list of subdirectories in that directory.
659 Notes: this does not traverse into subdirectories. Only the first
660 level of subdirectories are returned.
661 The directory names returned don't have the parent directory name on them.
665 sub _getSubdirectoryNames
{
666 my $directoryname = shift;
667 return unless defined $directoryname;
668 return unless -d
$directoryname;
670 if ( opendir ( my $dh, $directoryname ) ) {
671 my @directories = grep { -d File
::Spec
->catfile( $directoryname, $_ ) && ! ( /^\./ ) } readdir( $dh );
675 warn "unable to opendir $directoryname: $!";
682 returns: a listref of hashrefs. Each hash represents another collection of images.
684 { imagesetname => 'npl', # the name of the image set (npl is the original one)
685 images => listref of image hashrefs
688 each image is represented by a hashref like this:
690 { KohaImage => 'npl/image.gif',
691 StaffImageUrl => '/intranet-tmpl/prog/img/itemtypeimg/npl/image.gif',
692 OpacImageURL => '/opac-tmpl/prog/itemtypeimg/npl/image.gif'
693 checked => 0 or 1: was this the image passed to this method?
694 Note: I'd like to remove this somehow.
701 my $checked = $params{'checked'} || '';
703 my $paths = { staff
=> { filesystem
=> getitemtypeimagedir
('intranet'),
704 url
=> getitemtypeimagesrc
('intranet'),
706 opac
=> { filesystem
=> getitemtypeimagedir
('opac'),
707 url
=> getitemtypeimagesrc
('opac'),
711 my @imagesets = (); # list of hasrefs of image set data to pass to template
712 my @subdirectories = _getSubdirectoryNames
( $paths->{'staff'}{'filesystem'} );
713 foreach my $imagesubdir ( @subdirectories ) {
714 warn $imagesubdir if $DEBUG;
715 my @imagelist = (); # hashrefs of image info
716 my @imagenames = _getImagesFromDirectory
( File
::Spec
->catfile( $paths->{'staff'}{'filesystem'}, $imagesubdir ) );
717 my $imagesetactive = 0;
718 foreach my $thisimage ( @imagenames ) {
720 { KohaImage
=> "$imagesubdir/$thisimage",
721 StaffImageUrl
=> join( '/', $paths->{'staff'}{'url'}, $imagesubdir, $thisimage ),
722 OpacImageUrl
=> join( '/', $paths->{'opac'}{'url'}, $imagesubdir, $thisimage ),
723 checked
=> "$imagesubdir/$thisimage" eq $checked ?
1 : 0,
726 $imagesetactive = 1 if "$imagesubdir/$thisimage" eq $checked;
728 push @imagesets, { imagesetname
=> $imagesubdir,
729 imagesetactive
=> $imagesetactive,
730 images
=> \
@imagelist };
738 $printers = &GetPrinters();
739 @queues = keys %$printers;
741 Returns information about existing printer queues.
743 C<$printers> is a reference-to-hash whose keys are the print queues
744 defined in the printers table of the Koha database. The values are
745 references-to-hash, whose keys are the fields in the printers table.
751 my $dbh = C4
::Context
->dbh;
752 my $sth = $dbh->prepare("select * from printers");
754 while ( my $printer = $sth->fetchrow_hashref ) {
755 $printers{ $printer->{'printqueue'} } = $printer;
757 return ( \
%printers );
762 $printer = GetPrinter( $query, $printers );
767 my ( $query, $printers ) = @_; # get printer for this query from printers
768 my $printer = $query->param('printer');
769 my %cookie = $query->cookie('userenv');
770 ($printer) || ( $printer = $cookie{'printer'} ) || ( $printer = '' );
771 ( $printers->{$printer} ) || ( $printer = ( keys %$printers )[0] );
777 Returns the number of pages to display in a pagination bar, given the number
778 of items and the number of items per page.
783 my ( $nb_items, $nb_items_per_page ) = @_;
785 return int( ( $nb_items - 1 ) / $nb_items_per_page ) + 1;
790 (@themes) = &getallthemes('opac');
791 (@themes) = &getallthemes('intranet');
793 Returns an array of all available themes.
801 if ( $type eq 'intranet' ) {
802 $htdocs = C4
::Context
->config('intrahtdocs');
805 $htdocs = C4
::Context
->config('opachtdocs');
807 opendir D
, "$htdocs";
808 my @dirlist = readdir D
;
809 foreach my $directory (@dirlist) {
810 next if $directory eq 'lib';
811 -d
"$htdocs/$directory/en" and push @themes, $directory;
818 if ( C4
::Context
->preference("marcflavour") eq "UNIMARC" ) {
823 tags
=> [ qw
/ 600ab 601ab 602a 604at 605a 606ax 610a / ],
829 tags
=> [ qw
/ 607a / ],
835 tags
=> [ qw
/ 500a 501a 503a / ],
841 tags
=> [ qw
/ 700ab 701ab 702ab / ],
842 sep
=> C4
::Context
->preference("UNIMARCAuthorsFacetsSeparator"),
847 tags
=> [ qw
/ 225a / ],
853 tags
=> [ qw
/ 995e / ],
857 unless ( C4
::Context
->preference("singleBranchMode")
858 || GetBranchesCount
() == 1 )
860 my $DisplayLibraryFacets = C4
::Context
->preference('DisplayLibraryFacets');
861 if ( $DisplayLibraryFacets eq 'both'
862 || $DisplayLibraryFacets eq 'holding' )
867 idx
=> 'holdingbranch',
868 label
=> 'HoldingLibrary',
869 tags
=> [qw
/ 995c /],
874 if ( $DisplayLibraryFacets eq 'both'
875 || $DisplayLibraryFacets eq 'home' )
881 label
=> 'HomeLibrary',
882 tags
=> [qw
/ 995b /],
893 tags
=> [ qw
/ 650a / ],
898 # label => 'People and Organizations',
899 # tags => [ qw/ 600a 610a 611a / ],
905 tags
=> [ qw
/ 651a / ],
911 tags
=> [ qw
/ 630a / ],
917 tags
=> [ qw
/ 100a 110a 700a / ],
923 tags
=> [ qw
/ 440a 490a / ],
928 label
=> 'ItemTypes',
929 tags
=> [ qw
/ 952y 942c / ],
935 tags
=> [ qw
/ 952c / ],
939 unless ( C4
::Context
->preference("singleBranchMode")
940 || GetBranchesCount
() == 1 )
942 my $DisplayLibraryFacets = C4
::Context
->preference('DisplayLibraryFacets');
943 if ( $DisplayLibraryFacets eq 'both'
944 || $DisplayLibraryFacets eq 'holding' )
949 idx
=> 'holdingbranch',
950 label
=> 'HoldingLibrary',
951 tags
=> [qw
/ 952b /],
956 if ( $DisplayLibraryFacets eq 'both'
957 || $DisplayLibraryFacets eq 'home' )
963 label
=> 'HomeLibrary',
964 tags
=> [qw
/ 952a /],
975 Return a href where a key is associated to a href. You give a query,
976 the name of the key among the fields returned by the query. If you
977 also give as third argument the name of the value, the function
978 returns a href of scalar. The optional 4th argument is an arrayref of
979 items passed to the C<execute()> call. It is designed to bind
980 parameters to any placeholders in your SQL.
989 # generic href of any information on the item, href of href.
990 my $iteminfos_of = get_infos_of($query, 'itemnumber');
991 print $iteminfos_of->{$itemnumber}{barcode};
993 # specific information, href of scalar
994 my $barcode_of_item = get_infos_of($query, 'itemnumber', 'barcode');
995 print $barcode_of_item->{$itemnumber};
1000 my ( $query, $key_name, $value_name, $bind_params ) = @_;
1002 my $dbh = C4
::Context
->dbh;
1004 my $sth = $dbh->prepare($query);
1005 $sth->execute( @
$bind_params );
1008 while ( my $row = $sth->fetchrow_hashref ) {
1009 if ( defined $value_name ) {
1010 $infos_of{ $row->{$key_name} } = $row->{$value_name};
1013 $infos_of{ $row->{$key_name} } = $row;
1021 =head2 get_notforloan_label_of
1023 my $notforloan_label_of = get_notforloan_label_of();
1025 Each authorised value of notforloan (information available in items and
1026 itemtypes) is link to a single label.
1028 Returns a href where keys are authorised values and values are corresponding
1031 foreach my $authorised_value (keys %{$notforloan_label_of}) {
1033 "authorised_value: %s => %s\n",
1035 $notforloan_label_of->{$authorised_value}
1041 # FIXME - why not use GetAuthorisedValues ??
1043 sub get_notforloan_label_of
{
1044 my $dbh = C4
::Context
->dbh;
1047 SELECT authorised_value
1048 FROM marc_subfield_structure
1049 WHERE kohafield = \'items.notforloan\'
1052 my $sth = $dbh->prepare($query);
1054 my ($statuscode) = $sth->fetchrow_array();
1059 FROM authorised_values
1062 $sth = $dbh->prepare($query);
1063 $sth->execute($statuscode);
1064 my %notforloan_label_of;
1065 while ( my $row = $sth->fetchrow_hashref ) {
1066 $notforloan_label_of{ $row->{authorised_value
} } = $row->{lib
};
1070 return \
%notforloan_label_of;
1073 =head2 displayServers
1075 my $servers = displayServers();
1076 my $servers = displayServers( $position );
1077 my $servers = displayServers( $position, $type );
1079 displayServers returns a listref of hashrefs, each containing
1080 information about available z3950 servers. Each hashref has a format
1084 'checked' => 'checked',
1085 'encoding' => 'utf8',
1087 'id' => 'LIBRARY OF CONGRESS',
1091 'value' => 'lx2.loc.gov:210/',
1097 sub displayServers
{
1098 my ( $position, $type ) = @_;
1099 my $dbh = C4
::Context
->dbh;
1101 my $strsth = 'SELECT * FROM z3950servers';
1106 push @bind_params, $position;
1107 push @where_clauses, ' position = ? ';
1111 push @bind_params, $type;
1112 push @where_clauses, ' type = ? ';
1115 # reassemble where clause from where clause pieces
1116 if (@where_clauses) {
1117 $strsth .= ' WHERE ' . join( ' AND ', @where_clauses );
1120 my $rq = $dbh->prepare($strsth);
1121 $rq->execute(@bind_params);
1122 my @primaryserverloop;
1124 while ( my $data = $rq->fetchrow_hashref ) {
1125 push @primaryserverloop,
1126 { label
=> $data->{description
},
1127 id
=> $data->{name
},
1129 value
=> $data->{host
} . ":" . $data->{port
} . "/" . $data->{database
},
1130 encoding
=> ( $data->{encoding
} ?
$data->{encoding
} : "iso-5426" ),
1131 checked
=> "checked",
1132 icon
=> $data->{icon
},
1133 zed
=> $data->{type
} eq 'zed',
1134 opensearch
=> $data->{type
} eq 'opensearch'
1137 return \
@primaryserverloop;
1141 =head2 GetKohaImageurlFromAuthorisedValues
1143 $authhorised_value = GetKohaImageurlFromAuthorisedValues( $category, $authvalcode );
1145 Return the first url of the authorised value image represented by $lib.
1149 sub GetKohaImageurlFromAuthorisedValues
{
1150 my ( $category, $lib ) = @_;
1151 my $dbh = C4
::Context
->dbh;
1152 my $sth = $dbh->prepare("SELECT imageurl FROM authorised_values WHERE category=? AND lib =?");
1153 $sth->execute( $category, $lib );
1154 while ( my $data = $sth->fetchrow_hashref ) {
1155 return $data->{'imageurl'};
1159 =head2 GetAuthValCode
1161 $authvalcode = GetAuthValCode($kohafield,$frameworkcode);
1165 sub GetAuthValCode
{
1166 my ($kohafield,$fwcode) = @_;
1167 my $dbh = C4
::Context
->dbh;
1168 $fwcode='' unless $fwcode;
1169 my $sth = $dbh->prepare('select authorised_value from marc_subfield_structure where kohafield=? and frameworkcode=?');
1170 $sth->execute($kohafield,$fwcode);
1171 my ($authvalcode) = $sth->fetchrow_array;
1172 return $authvalcode;
1175 =head2 GetAuthValCodeFromField
1177 $authvalcode = GetAuthValCodeFromField($field,$subfield,$frameworkcode);
1179 C<$subfield> can be undefined
1183 sub GetAuthValCodeFromField
{
1184 my ($field,$subfield,$fwcode) = @_;
1185 my $dbh = C4
::Context
->dbh;
1186 $fwcode='' unless $fwcode;
1188 if (defined $subfield) {
1189 $sth = $dbh->prepare('select authorised_value from marc_subfield_structure where tagfield=? and tagsubfield=? and frameworkcode=?');
1190 $sth->execute($field,$subfield,$fwcode);
1192 $sth = $dbh->prepare('select authorised_value from marc_tag_structure where tagfield=? and frameworkcode=?');
1193 $sth->execute($field,$fwcode);
1195 my ($authvalcode) = $sth->fetchrow_array;
1196 return $authvalcode;
1199 =head2 GetAuthorisedValues
1201 $authvalues = GetAuthorisedValues([$category], [$selected]);
1203 This function returns all authorised values from the'authorised_value' table in a reference to array of hashrefs.
1205 C<$category> returns authorised values for just one category (optional).
1207 C<$selected> adds a "selected => 1" entry to the hash if the
1208 authorised_value matches it. B<NOTE:> this feature should be considered
1209 deprecated as it may be removed in the future.
1211 C<$opac> If set to a true value, displays OPAC descriptions rather than normal ones when they exist.
1215 sub GetAuthorisedValues
{
1216 my ( $category, $selected, $opac ) = @_;
1218 # TODO: the "selected" feature should be replaced by a utility function
1219 # somewhere else, it doesn't belong in here. For starters it makes
1220 # caching much more complicated. Or just let the UI logic handle it, it's
1223 # Is this cached already?
1224 $opac = $opac ?
1 : 0; # normalise to be safe
1226 C4
::Context
->userenv ? C4
::Context
->userenv->{"branch"} : "";
1227 my $selected_key = defined($selected) ?
$selected : '';
1229 "AuthorisedValues-$category-$selected_key-$opac-$branch_limit";
1230 my $cache = Koha
::Cache
->get_instance();
1231 my $result = $cache->get_from_cache($cache_key);
1232 return $result if $result;
1235 my $dbh = C4
::Context
->dbh;
1238 FROM authorised_values
1241 LEFT JOIN authorised_values_branches ON
( id
= av_id
)
1246 push @where_strings, "category = ?";
1247 push @where_args, $category;
1250 push @where_strings, "( branchcode = ? OR branchcode IS NULL )";
1251 push @where_args, $branch_limit;
1253 if(@where_strings > 0) {
1254 $query .= " WHERE " . join(" AND ", @where_strings);
1256 $query .= " GROUP BY lib";
1257 $query .= ' ORDER BY category, ' . (
1258 $opac ?
'COALESCE(lib_opac, lib)'
1262 my $sth = $dbh->prepare($query);
1264 $sth->execute( @where_args );
1265 while (my $data=$sth->fetchrow_hashref) {
1266 if ( defined $selected and $selected eq $data->{authorised_value
} ) {
1267 $data->{selected
} = 1;
1270 $data->{selected
} = 0;
1273 if ($opac && $data->{lib_opac
}) {
1274 $data->{lib
} = $data->{lib_opac
};
1276 push @results, $data;
1280 # We can't cache for long because of that "selected" thing which
1281 # makes it impossible to clear the cache without iterating through every
1282 # value, which sucks. This'll cover this request, and not a whole lot more.
1283 $cache->set_in_cache( $cache_key, \
@results, { deepcopy
=> 1, expiry
=> 5 } );
1287 =head2 GetAuthorisedValueCategories
1289 $auth_categories = GetAuthorisedValueCategories();
1291 Return an arrayref of all of the available authorised
1296 sub GetAuthorisedValueCategories
{
1297 my $dbh = C4
::Context
->dbh;
1298 my $sth = $dbh->prepare("SELECT DISTINCT category FROM authorised_values ORDER BY category");
1301 while (defined (my $category = $sth->fetchrow_array) ) {
1302 push @results, $category;
1307 =head2 IsAuthorisedValueCategory
1309 $is_auth_val_category = IsAuthorisedValueCategory($category);
1311 Returns whether a given category name is a valid one
1315 sub IsAuthorisedValueCategory
{
1316 my $category = shift;
1319 FROM authorised_values
1323 my $sth = C4
::Context
->dbh->prepare($query);
1324 $sth->execute($category);
1325 $sth->fetchrow ?
return 1
1329 =head2 GetAuthorisedValueByCode
1331 $authorised_value = GetAuthorisedValueByCode( $category, $authvalcode, $opac );
1333 Return the lib attribute from authorised_values from the row identified
1334 by the passed category and code
1338 sub GetAuthorisedValueByCode
{
1339 my ( $category, $authvalcode, $opac ) = @_;
1341 my $field = $opac ?
'lib_opac' : 'lib';
1342 my $dbh = C4
::Context
->dbh;
1343 my $sth = $dbh->prepare("SELECT $field FROM authorised_values WHERE category=? AND authorised_value =?");
1344 $sth->execute( $category, $authvalcode );
1345 while ( my $data = $sth->fetchrow_hashref ) {
1346 return $data->{ $field };
1350 =head2 GetKohaAuthorisedValues
1352 Takes $kohafield, $fwcode as parameters.
1354 If $opac parameter is set to a true value, displays OPAC descriptions rather than normal ones when they exist.
1356 Returns hashref of Code => description
1358 Returns undef if no authorised value category is defined for the kohafield.
1362 sub GetKohaAuthorisedValues
{
1363 my ($kohafield,$fwcode,$opac) = @_;
1364 $fwcode='' unless $fwcode;
1366 my $dbh = C4
::Context
->dbh;
1367 my $avcode = GetAuthValCode
($kohafield,$fwcode);
1369 my $sth = $dbh->prepare("select authorised_value, lib, lib_opac from authorised_values where category=? ");
1370 $sth->execute($avcode);
1371 while ( my ($val, $lib, $lib_opac) = $sth->fetchrow_array ) {
1372 $values{$val} = ($opac && $lib_opac) ?
$lib_opac : $lib;
1380 =head2 GetKohaAuthorisedValuesFromField
1382 Takes $field, $subfield, $fwcode as parameters.
1384 If $opac parameter is set to a true value, displays OPAC descriptions rather than normal ones when they exist.
1385 $subfield can be undefined
1387 Returns hashref of Code => description
1389 Returns undef if no authorised value category is defined for the given field and subfield
1393 sub GetKohaAuthorisedValuesFromField
{
1394 my ($field, $subfield, $fwcode,$opac) = @_;
1395 $fwcode='' unless $fwcode;
1397 my $dbh = C4
::Context
->dbh;
1398 my $avcode = GetAuthValCodeFromField
($field, $subfield, $fwcode);
1400 my $sth = $dbh->prepare("select authorised_value, lib, lib_opac from authorised_values where category=? ");
1401 $sth->execute($avcode);
1402 while ( my ($val, $lib, $lib_opac) = $sth->fetchrow_array ) {
1403 $values{$val} = ($opac && $lib_opac) ?
$lib_opac : $lib;
1411 =head2 GetKohaAuthorisedValuesMapping
1413 Takes a hash as a parameter. The interface key indicates the
1414 description to use in the mapping.
1417 "{kohafield},{frameworkcode},{authorised_value}" => "{description}"
1418 for all the kohafields, frameworkcodes, and authorised values.
1420 Returns undef if nothing is found.
1424 sub GetKohaAuthorisedValuesMapping
{
1425 my ($parameter) = @_;
1426 my $interface = $parameter->{'interface'} // '';
1428 my $query_mapping = q{
1429 SELECT TA.kohafield,TA.authorised_value AS category,
1430 TA.frameworkcode,TB.authorised_value,
1431 IF(TB.lib_opac>'',TB.lib_opac,TB.lib) AS OPAC,
1432 TB.lib AS Intranet,TB.lib_opac
1433 FROM marc_subfield_structure AS TA JOIN
1434 authorised_values as TB ON
1435 TA.authorised_value=TB.category
1436 WHERE TA.kohafield>'' AND TA.authorised_value>'';
1438 my $dbh = C4
::Context
->dbh;
1439 my $sth = $dbh->prepare($query_mapping);
1442 if ($interface eq 'opac') {
1443 while (my $row = $sth->fetchrow_hashref) {
1444 $avmapping->{$row->{kohafield
}.",".$row->{frameworkcode
}.",".$row->{authorised_value
}} = $row->{OPAC
};
1448 while (my $row = $sth->fetchrow_hashref) {
1449 $avmapping->{$row->{kohafield
}.",".$row->{frameworkcode
}.",".$row->{authorised_value
}} = $row->{Intranet
};
1457 my $escaped_string = C4::Koha::xml_escape($string);
1459 Convert &, <, >, ', and " in a string to XML entities
1465 return '' unless defined $str;
1466 $str =~ s/&/&/g;
1469 $str =~ s/'/'/g;
1470 $str =~ s/"/"/g;
1474 =head2 GetKohaAuthorisedValueLib
1476 Takes $category, $authorised_value as parameters.
1478 If $opac parameter is set to a true value, displays OPAC descriptions rather than normal ones when they exist.
1480 Returns authorised value description
1484 sub GetKohaAuthorisedValueLib
{
1485 my ($category,$authorised_value,$opac) = @_;
1487 my $dbh = C4
::Context
->dbh;
1488 my $sth = $dbh->prepare("select lib, lib_opac from authorised_values where category=? and authorised_value=?");
1489 $sth->execute($category,$authorised_value);
1490 my $data = $sth->fetchrow_hashref;
1491 $value = ($opac && $$data{'lib_opac'}) ?
$$data{'lib_opac'} : $$data{'lib'};
1495 =head2 AddAuthorisedValue
1497 AddAuthorisedValue($category, $authorised_value, $lib, $lib_opac, $imageurl);
1499 Create a new authorised value.
1503 sub AddAuthorisedValue
{
1504 my ($category, $authorised_value, $lib, $lib_opac, $imageurl) = @_;
1506 my $dbh = C4
::Context
->dbh;
1508 INSERT INTO authorised_values
(category
, authorised_value
, lib
, lib_opac
, imageurl
)
1511 my $sth = $dbh->prepare($query);
1512 $sth->execute($category, $authorised_value, $lib, $lib_opac, $imageurl);
1515 =head2 display_marc_indicators
1517 my $display_form = C4::Koha::display_marc_indicators($field);
1519 C<$field> is a MARC::Field object
1521 Generate a display form of the indicators of a variable
1522 MARC field, replacing any blanks with '#'.
1526 sub display_marc_indicators
{
1528 my $indicators = '';
1529 if ($field->tag() >= 10) {
1530 $indicators = $field->indicator(1) . $field->indicator(2);
1531 $indicators =~ s/ /#/g;
1536 sub GetNormalizedUPC
{
1537 my ($record,$marcflavour) = @_;
1540 if ($marcflavour eq 'UNIMARC') {
1541 @fields = $record->field('072');
1542 foreach my $field (@fields) {
1543 my $upc = _normalize_match_point
($field->subfield('a'));
1550 else { # assume marc21 if not unimarc
1551 @fields = $record->field('024');
1552 foreach my $field (@fields) {
1553 my $indicator = $field->indicator(1);
1554 my $upc = _normalize_match_point
($field->subfield('a'));
1555 if ($indicator == 1 and $upc ne '') {
1562 # Normalizes and returns the first valid ISBN found in the record
1563 # ISBN13 are converted into ISBN10. This is required to get some book cover images.
1564 sub GetNormalizedISBN
{
1565 my ($isbn,$record,$marcflavour) = @_;
1568 # Koha attempts to store multiple ISBNs in biblioitems.isbn, separated by " | "
1569 # anything after " | " should be removed, along with the delimiter
1570 ($isbn) = split(/\|/, $isbn );
1571 return _isbn_cleanup
($isbn);
1573 return unless $record;
1575 if ($marcflavour eq 'UNIMARC') {
1576 @fields = $record->field('010');
1577 foreach my $field (@fields) {
1578 my $isbn = $field->subfield('a');
1580 return _isbn_cleanup
($isbn);
1586 else { # assume marc21 if not unimarc
1587 @fields = $record->field('020');
1588 foreach my $field (@fields) {
1589 $isbn = $field->subfield('a');
1591 return _isbn_cleanup
($isbn);
1599 sub GetNormalizedEAN
{
1600 my ($record,$marcflavour) = @_;
1603 if ($marcflavour eq 'UNIMARC') {
1604 @fields = $record->field('073');
1605 foreach my $field (@fields) {
1606 $ean = _normalize_match_point
($field->subfield('a'));
1612 else { # assume marc21 if not unimarc
1613 @fields = $record->field('024');
1614 foreach my $field (@fields) {
1615 my $indicator = $field->indicator(1);
1616 $ean = _normalize_match_point
($field->subfield('a'));
1617 if ($indicator == 3 and $ean ne '') {
1623 sub GetNormalizedOCLCNumber
{
1624 my ($record,$marcflavour) = @_;
1627 if ($marcflavour eq 'UNIMARC') {
1628 # TODO: add UNIMARC fields
1630 else { # assume marc21 if not unimarc
1631 @fields = $record->field('035');
1632 foreach my $field (@fields) {
1633 $oclc = $field->subfield('a');
1634 if ($oclc =~ /OCoLC/) {
1635 $oclc =~ s/\(OCoLC\)//;
1644 sub GetAuthvalueDropbox
{
1645 my ( $authcat, $default ) = @_;
1646 my $branch_limit = C4
::Context
->userenv ? C4
::Context
->userenv->{"branch"} : "";
1647 my $dbh = C4
::Context
->dbh;
1651 FROM authorised_values
1654 LEFT JOIN authorised_values_branches ON
( id
= av_id
)
1659 $query .= " AND ( branchcode = ? OR branchcode IS NULL )" if $branch_limit;
1660 $query .= " GROUP BY lib ORDER BY category, lib, lib_opac";
1661 my $sth = $dbh->prepare($query);
1662 $sth->execute( $authcat, $branch_limit ?
$branch_limit : () );
1665 my $option_list = [];
1666 my @authorised_values = ( q{} );
1667 while (my $av = $sth->fetchrow_hashref) {
1668 push @
{$option_list}, {
1669 value
=> $av->{authorised_value
},
1670 label
=> $av->{lib
},
1671 default => ($default eq $av->{authorised_value
}),
1675 if ( @
{$option_list} ) {
1676 return $option_list;
1682 =head2 GetDailyQuote($opts)
1684 Takes a hashref of options
1686 Currently supported options are:
1688 'id' An exact quote id
1689 'random' Select a random quote
1690 noop When no option is passed in, this sub will return the quote timestamped for the current day
1692 The function returns an anonymous hash following this format:
1695 'source' => 'source-of-quote',
1696 'timestamp' => 'timestamp-value',
1697 'text' => 'text-of-quote',
1703 # This is definitely a candidate for some sort of caching once we finally settle caching/persistence issues...
1704 # at least for default option
1708 my $dbh = C4
::Context
->dbh;
1713 $query = 'SELECT * FROM quotes WHERE id = ?';
1714 $sth = $dbh->prepare($query);
1715 $sth->execute($opts{'id'});
1716 $quote = $sth->fetchrow_hashref();
1718 elsif ($opts{'random'}) {
1719 # Fall through... we also return a random quote as a catch-all if all else fails
1722 $query = 'SELECT * FROM quotes WHERE timestamp LIKE CONCAT(CURRENT_DATE,\'%\') ORDER BY timestamp DESC LIMIT 0,1';
1723 $sth = $dbh->prepare($query);
1725 $quote = $sth->fetchrow_hashref();
1727 unless ($quote) { # if there are not matches, choose a random quote
1728 # get a list of all available quote ids
1729 $sth = C4
::Context
->dbh->prepare('SELECT count(*) FROM quotes;');
1731 my $range = ($sth->fetchrow_array)[0];
1732 # chose a random id within that range if there is more than one quote
1733 my $offset = int(rand($range));
1735 $query = 'SELECT * FROM quotes ORDER BY id LIMIT 1 OFFSET ?';
1736 $sth = C4
::Context
->dbh->prepare($query);
1737 # see http://www.perlmonks.org/?node_id=837422 for why
1738 # we're being verbose and using bind_param
1739 $sth->bind_param(1, $offset, SQL_INTEGER
);
1741 $quote = $sth->fetchrow_hashref();
1742 # update the timestamp for that quote
1743 $query = 'UPDATE quotes SET timestamp = ? WHERE id = ?';
1744 $sth = C4
::Context
->dbh->prepare($query);
1746 DateTime
::Format
::MySQL
->format_datetime( dt_from_string
() ),
1753 sub _normalize_match_point
{
1754 my $match_point = shift;
1755 (my $normalized_match_point) = $match_point =~ /([\d-]*[X]*)/;
1756 $normalized_match_point =~ s/-//g;
1758 return $normalized_match_point;
1763 return NormalizeISBN
(
1766 format
=> 'ISBN-10',
1772 =head2 NormalizedISBN
1774 my $isbns = NormalizedISBN({
1776 strip_hyphens => [0,1],
1777 format => ['ISBN-10', 'ISBN-13']
1780 Returns an isbn validated by Business::ISBN.
1781 Optionally strips hyphens and/or forces the isbn
1782 to be of the specified format.
1784 If the string cannot be validated as an isbn,
1792 my $string = $params->{isbn
};
1793 my $strip_hyphens = $params->{strip_hyphens
};
1794 my $format = $params->{format
};
1796 return unless $string;
1798 my $isbn = Business
::ISBN
->new($string);
1800 if ( $isbn && $isbn->is_valid() ) {
1802 if ( $format eq 'ISBN-10' ) {
1803 $isbn = $isbn->as_isbn10();
1805 elsif ( $format eq 'ISBN-13' ) {
1806 $isbn = $isbn->as_isbn13();
1808 return unless $isbn;
1810 if ($strip_hyphens) {
1811 $string = $isbn->as_string( [] );
1813 $string = $isbn->as_string();
1820 =head2 GetVariationsOfISBN
1822 my @isbns = GetVariationsOfISBN( $isbn );
1824 Returns a list of variations of the given isbn in
1825 both ISBN-10 and ISBN-13 formats, with and without
1828 In a scalar context, the isbns are returned as a
1829 string delimited by ' | '.
1833 sub GetVariationsOfISBN
{
1836 return unless $isbn;
1840 push( @isbns, NormalizeISBN
({ isbn
=> $isbn }) );
1841 push( @isbns, NormalizeISBN
({ isbn
=> $isbn, format
=> 'ISBN-10' }) );
1842 push( @isbns, NormalizeISBN
({ isbn
=> $isbn, format
=> 'ISBN-13' }) );
1843 push( @isbns, NormalizeISBN
({ isbn
=> $isbn, format
=> 'ISBN-10', strip_hyphens
=> 1 }) );
1844 push( @isbns, NormalizeISBN
({ isbn
=> $isbn, format
=> 'ISBN-13', strip_hyphens
=> 1 }) );
1846 # Strip out any "empty" strings from the array
1847 @isbns = grep { defined($_) && $_ =~ /\S/ } @isbns;
1849 return wantarray ?
@isbns : join( " | ", @isbns );
1852 =head2 GetVariationsOfISBNs
1854 my @isbns = GetVariationsOfISBNs( @isbns );
1856 Returns a list of variations of the given isbns in
1857 both ISBN-10 and ISBN-13 formats, with and without
1860 In a scalar context, the isbns are returned as a
1861 string delimited by ' | '.
1865 sub GetVariationsOfISBNs
{
1868 @isbns = map { GetVariationsOfISBN
( $_ ) } @isbns;
1870 return wantarray ?
@isbns : join( " | ", @isbns );
1873 =head2 IsKohaFieldLinked
1875 my $is_linked = IsKohaFieldLinked({
1876 kohafield => $kohafield,
1877 frameworkcode => $frameworkcode,
1880 Return 1 if the field is linked
1884 sub IsKohaFieldLinked
{
1885 my ( $params ) = @_;
1886 my $kohafield = $params->{kohafield
};
1887 my $frameworkcode = $params->{frameworkcode
} || '';
1888 my $dbh = C4
::Context
->dbh;
1889 my $is_linked = $dbh->selectcol_arrayref( q
|
1891 FROM marc_subfield_structure
1892 WHERE frameworkcode
= ?
1894 |,{}, $frameworkcode, $kohafield );
1895 return $is_linked->[0];