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