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 DateTime::Format::MySQL;
  31 use Business::ISBN;
  32 use autouse 'Data::cselectall_arrayref' => qw(Dumper);
  33 use DBI qw(:sql_types);
  34 use vars qw(@ISA @EXPORT @EXPORT_OK $DEBUG);
  35
  36 BEGIN {
  37         require Exporter;
  38         @ISA    = qw(Exporter);
  39         @EXPORT = qw(
  40                 &GetPrinters &GetPrinter
  41                 &GetItemTypes &getitemtypeinfo
  42                 &GetItemTypesCategorized &GetItemTypesByCategory
  43                 &getframeworks &getframeworkinfo
  44         &GetFrameworksLoop
  45                 &getallthemes
  46                 &getFacets
  47                 &getnbpages
  48                 &get_infos_of
  49                 &get_notforloan_label_of
  50                 &getitemtypeimagedir
  51                 &getitemtypeimagesrc
  52                 &getitemtypeimagelocation
  53                 &GetAuthorisedValues
  54                 &GetAuthorisedValueCategories
  55                 &GetKohaAuthorisedValues
  56                 &GetKohaAuthorisedValuesFromField
  57     &GetKohaAuthorisedValuesMapping
  58     &GetKohaAuthorisedValueLib
  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, { deepcopy => 1, 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 GetKohaAuthorisedValueLib
1157
1158 Takes $category, $authorised_value as parameters.
1159
1160 If $opac parameter is set to a true value, displays OPAC descriptions rather than normal ones when they exist.
1161
1162 Returns authorised value description
1163
1164 =cut
1165
1166 sub GetKohaAuthorisedValueLib {
1167   my ($category,$authorised_value,$opac) = @_;
1168   my $value;
1169   my $dbh = C4::Context->dbh;
1170   my $sth = $dbh->prepare("select lib, lib_opac from authorised_values where category=? and authorised_value=?");
1171   $sth->execute($category,$authorised_value);
1172   my $data = $sth->fetchrow_hashref;
1173   $value = ($opac && $$data{'lib_opac'}) ? $$data{'lib_opac'} : $$data{'lib'};
1174   return $value;
1175 }
1176
1177 =head2 display_marc_indicators
1178
1179   my $display_form = C4::Koha::display_marc_indicators($field);
1180
1181 C<$field> is a MARC::Field object
1182
1183 Generate a display form of the indicators of a variable
1184 MARC field, replacing any blanks with '#'.
1185
1186 =cut
1187
1188 sub display_marc_indicators {
1189     my $field = shift;
1190     my $indicators = '';
1191     if ($field && $field->tag() >= 10) {
1192         $indicators = $field->indicator(1) . $field->indicator(2);
1193         $indicators =~ s/ /#/g;
1194     }
1195     return $indicators;
1196 }
1197
1198 sub GetNormalizedUPC {
1199     my ($marcrecord,$marcflavour) = @_;
1200
1201     return unless $marcrecord;
1202     if ($marcflavour eq 'UNIMARC') {
1203         my @fields = $marcrecord->field('072');
1204         foreach my $field (@fields) {
1205             my $upc = _normalize_match_point($field->subfield('a'));
1206             if ($upc) {
1207                 return $upc;
1208             }
1209         }
1210
1211     }
1212     else { # assume marc21 if not unimarc
1213         my @fields = $marcrecord->field('024');
1214         foreach my $field (@fields) {
1215             my $indicator = $field->indicator(1);
1216             my $upc = _normalize_match_point($field->subfield('a'));
1217             if ($upc && $indicator == 1 ) {
1218                 return $upc;
1219             }
1220         }
1221     }
1222 }
1223
1224 # Normalizes and returns the first valid ISBN found in the record
1225 # ISBN13 are converted into ISBN10. This is required to get some book cover images.
1226 sub GetNormalizedISBN {
1227     my ($isbn,$marcrecord,$marcflavour) = @_;
1228     if ($isbn) {
1229         # Koha attempts to store multiple ISBNs in biblioitems.isbn, separated by " | "
1230         # anything after " | " should be removed, along with the delimiter
1231         ($isbn) = split(/\|/, $isbn );
1232         return _isbn_cleanup($isbn);
1233     }
1234
1235     return unless $marcrecord;
1236
1237     if ($marcflavour eq 'UNIMARC') {
1238         my @fields = $marcrecord->field('010');
1239         foreach my $field (@fields) {
1240             my $isbn = $field->subfield('a');
1241             if ($isbn) {
1242                 return _isbn_cleanup($isbn);
1243             }
1244         }
1245     }
1246     else { # assume marc21 if not unimarc
1247         my @fields = $marcrecord->field('020');
1248         foreach my $field (@fields) {
1249             $isbn = $field->subfield('a');
1250             if ($isbn) {
1251                 return _isbn_cleanup($isbn);
1252             }
1253         }
1254     }
1255 }
1256
1257 sub GetNormalizedEAN {
1258     my ($marcrecord,$marcflavour) = @_;
1259
1260     return unless $marcrecord;
1261
1262     if ($marcflavour eq 'UNIMARC') {
1263         my @fields = $marcrecord->field('073');
1264         foreach my $field (@fields) {
1265             my $ean = _normalize_match_point($field->subfield('a'));
1266             if ( $ean ) {
1267                 return $ean;
1268             }
1269         }
1270     }
1271     else { # assume marc21 if not unimarc
1272         my @fields = $marcrecord->field('024');
1273         foreach my $field (@fields) {
1274             my $indicator = $field->indicator(1);
1275             my $ean = _normalize_match_point($field->subfield('a'));
1276             if ( $ean && $indicator == 3  ) {
1277                 return $ean;
1278             }
1279         }
1280     }
1281 }
1282
1283 sub GetNormalizedOCLCNumber {
1284     my ($marcrecord,$marcflavour) = @_;
1285     return unless $marcrecord;
1286
1287     if ($marcflavour ne 'UNIMARC' ) {
1288         my @fields = $marcrecord->field('035');
1289         foreach my $field (@fields) {
1290             my $oclc = $field->subfield('a');
1291             if ($oclc =~ /OCoLC/) {
1292                 $oclc =~ s/\(OCoLC\)//;
1293                 return $oclc;
1294             }
1295         }
1296     } else {
1297         # TODO for UNIMARC
1298     }
1299     return
1300 }
1301
1302 sub GetAuthvalueDropbox {
1303     my ( $authcat, $default ) = @_;
1304     my $branch_limit = C4::Context->userenv ? C4::Context->userenv->{"branch"} : "";
1305     my $dbh = C4::Context->dbh;
1306
1307     my $query = qq{
1308         SELECT *
1309         FROM authorised_values
1310     };
1311     $query .= qq{
1312           LEFT JOIN authorised_values_branches ON ( id = av_id )
1313     } if $branch_limit;
1314     $query .= qq{
1315         WHERE category = ?
1316     };
1317     $query .= " AND ( branchcode = ? OR branchcode IS NULL )" if $branch_limit;
1318     $query .= " GROUP BY lib ORDER BY category, lib, lib_opac";
1319     my $sth = $dbh->prepare($query);
1320     $sth->execute( $authcat, $branch_limit ? $branch_limit : () );
1321
1322
1323     my $option_list = [];
1324     my @authorised_values = ( q{} );
1325     while (my $av = $sth->fetchrow_hashref) {
1326         push @{$option_list}, {
1327             value => $av->{authorised_value},
1328             label => $av->{lib},
1329             default => ($default eq $av->{authorised_value}),
1330         };
1331     }
1332
1333     if ( @{$option_list} ) {
1334         return $option_list;
1335     }
1336     return;
1337 }
1338
1339
1340 =head2 GetDailyQuote($opts)
1341
1342 Takes a hashref of options
1343
1344 Currently supported options are:
1345
1346 'id'        An exact quote id
1347 'random'    Select a random quote
1348 noop        When no option is passed in, this sub will return the quote timestamped for the current day
1349
1350 The function returns an anonymous hash following this format:
1351
1352         {
1353           'source' => 'source-of-quote',
1354           'timestamp' => 'timestamp-value',
1355           'text' => 'text-of-quote',
1356           'id' => 'quote-id'
1357         };
1358
1359 =cut
1360
1361 # This is definitely a candidate for some sort of caching once we finally settle caching/persistence issues...
1362 # at least for default option
1363
1364 sub GetDailyQuote {
1365     my %opts = @_;
1366     my $dbh = C4::Context->dbh;
1367     my $query = '';
1368     my $sth = undef;
1369     my $quote = undef;
1370     if ($opts{'id'}) {
1371         $query = 'SELECT * FROM quotes WHERE id = ?';
1372         $sth = $dbh->prepare($query);
1373         $sth->execute($opts{'id'});
1374         $quote = $sth->fetchrow_hashref();
1375     }
1376     elsif ($opts{'random'}) {
1377         # Fall through... we also return a random quote as a catch-all if all else fails
1378     }
1379     else {
1380         $query = 'SELECT * FROM quotes WHERE timestamp LIKE CONCAT(CURRENT_DATE,\'%\') ORDER BY timestamp DESC LIMIT 0,1';
1381         $sth = $dbh->prepare($query);
1382         $sth->execute();
1383         $quote = $sth->fetchrow_hashref();
1384     }
1385     unless ($quote) {        # if there are not matches, choose a random quote
1386         # get a list of all available quote ids
1387         $sth = C4::Context->dbh->prepare('SELECT count(*) FROM quotes;');
1388         $sth->execute;
1389         my $range = ($sth->fetchrow_array)[0];
1390         # chose a random id within that range if there is more than one quote
1391         my $offset = int(rand($range));
1392         # grab it
1393         $query = 'SELECT * FROM quotes ORDER BY id LIMIT 1 OFFSET ?';
1394         $sth = C4::Context->dbh->prepare($query);
1395         # see http://www.perlmonks.org/?node_id=837422 for why
1396         # we're being verbose and using bind_param
1397         $sth->bind_param(1, $offset, SQL_INTEGER);
1398         $sth->execute();
1399         $quote = $sth->fetchrow_hashref();
1400         # update the timestamp for that quote
1401         $query = 'UPDATE quotes SET timestamp = ? WHERE id = ?';
1402         $sth = C4::Context->dbh->prepare($query);
1403         $sth->execute(
1404             DateTime::Format::MySQL->format_datetime( dt_from_string() ),
1405             $quote->{'id'}
1406         );
1407     }
1408     return $quote;
1409 }
1410
1411 sub _normalize_match_point {
1412     my $match_point = shift;
1413     (my $normalized_match_point) = $match_point =~ /([\d-]*[X]*)/;
1414     $normalized_match_point =~ s/-//g;
1415
1416     return $normalized_match_point;
1417 }
1418
1419 sub _isbn_cleanup {
1420     my ($isbn) = @_;
1421     return NormalizeISBN(
1422         {
1423             isbn          => $isbn,
1424             format        => 'ISBN-10',
1425             strip_hyphens => 1,
1426         }
1427     ) if $isbn;
1428 }
1429
1430 =head2 NormalizedISBN
1431
1432   my $isbns = NormalizedISBN({
1433     isbn => $isbn,
1434     strip_hyphens => [0,1],
1435     format => ['ISBN-10', 'ISBN-13']
1436   });
1437
1438   Returns an isbn validated by Business::ISBN.
1439   Optionally strips hyphens and/or forces the isbn
1440   to be of the specified format.
1441
1442   If the string cannot be validated as an isbn,
1443   it returns nothing.
1444
1445 =cut
1446
1447 sub NormalizeISBN {
1448     my ($params) = @_;
1449
1450     my $string        = $params->{isbn};
1451     my $strip_hyphens = $params->{strip_hyphens};
1452     my $format        = $params->{format};
1453
1454     return unless $string;
1455
1456     my $isbn = Business::ISBN->new($string);
1457
1458     if ( $isbn && $isbn->is_valid() ) {
1459
1460         if ( $format eq 'ISBN-10' ) {
1461             $isbn = $isbn->as_isbn10();
1462         }
1463         elsif ( $format eq 'ISBN-13' ) {
1464             $isbn = $isbn->as_isbn13();
1465         }
1466         return unless $isbn;
1467
1468         if ($strip_hyphens) {
1469             $string = $isbn->as_string( [] );
1470         } else {
1471             $string = $isbn->as_string();
1472         }
1473
1474         return $string;
1475     }
1476 }
1477
1478 =head2 GetVariationsOfISBN
1479
1480   my @isbns = GetVariationsOfISBN( $isbn );
1481
1482   Returns a list of variations of the given isbn in
1483   both ISBN-10 and ISBN-13 formats, with and without
1484   hyphens.
1485
1486   In a scalar context, the isbns are returned as a
1487   string delimited by ' | '.
1488
1489 =cut
1490
1491 sub GetVariationsOfISBN {
1492     my ($isbn) = @_;
1493
1494     return unless $isbn;
1495
1496     my @isbns;
1497
1498     push( @isbns, NormalizeISBN({ isbn => $isbn }) );
1499     push( @isbns, NormalizeISBN({ isbn => $isbn, format => 'ISBN-10' }) );
1500     push( @isbns, NormalizeISBN({ isbn => $isbn, format => 'ISBN-13' }) );
1501     push( @isbns, NormalizeISBN({ isbn => $isbn, format => 'ISBN-10', strip_hyphens => 1 }) );
1502     push( @isbns, NormalizeISBN({ isbn => $isbn, format => 'ISBN-13', strip_hyphens => 1 }) );
1503
1504     # Strip out any "empty" strings from the array
1505     @isbns = grep { defined($_) && $_ =~ /\S/ } @isbns;
1506
1507     return wantarray ? @isbns : join( " | ", @isbns );
1508 }
1509
1510 =head2 GetVariationsOfISBNs
1511
1512   my @isbns = GetVariationsOfISBNs( @isbns );
1513
1514   Returns a list of variations of the given isbns in
1515   both ISBN-10 and ISBN-13 formats, with and without
1516   hyphens.
1517
1518   In a scalar context, the isbns are returned as a
1519   string delimited by ' | '.
1520
1521 =cut
1522
1523 sub GetVariationsOfISBNs {
1524     my (@isbns) = @_;
1525
1526     @isbns = map { GetVariationsOfISBN( $_ ) } @isbns;
1527
1528     return wantarray ? @isbns : join( " | ", @isbns );
1529 }
1530
1531 =head2 IsKohaFieldLinked
1532
1533     my $is_linked = IsKohaFieldLinked({
1534         kohafield => $kohafield,
1535         frameworkcode => $frameworkcode,
1536     });
1537
1538     Return 1 if the field is linked
1539
1540 =cut
1541
1542 sub IsKohaFieldLinked {
1543     my ( $params ) = @_;
1544     my $kohafield = $params->{kohafield};
1545     my $frameworkcode = $params->{frameworkcode} || '';
1546     my $dbh = C4::Context->dbh;
1547     my $is_linked = $dbh->selectcol_arrayref( q|
1548         SELECT COUNT(*)
1549         FROM marc_subfield_structure
1550         WHERE frameworkcode = ?
1551         AND kohafield = ?
1552     |,{}, $frameworkcode, $kohafield );
1553     return $is_linked->[0];
1554 }
1555
1556 1;
1557
1558 __END__
1559
1560 =head1 AUTHOR
1561
1562 Koha Team
1563
1564 =cut