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