C4/Koha.pm

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