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