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