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
 713             my $library_facet;
 714             unless ( C4::Context->preference("singleBranchMode") || GetBranchesCount() == 1 ) {
 715                 $library_facet = {
 716                     idx  => 'branch',
 717                     label => 'Libraries',
 718                     tags        => [ qw/ 995b / ],
 719                 };
 720             } else {
 721                 $library_facet = {
 722                     idx  => 'location',
 723                     label => 'Location',
 724                     tags        => [ qw/ 995c / ],
 725                 };
 726             }
 727             push( @$facets, $library_facet );
 728     }
 729     else {
 730         $facets = [
 731             {
 732                 idx   => 'su-to',
 733                 label => 'Topics',
 734                 tags  => [ qw/ 650a / ],
 735                 sep   => '--',
 736             },
 737             #        {
 738             #        idx   => 'su-na',
 739             #        label => 'People and Organizations',
 740             #        tags  => [ qw/ 600a 610a 611a / ],
 741             #        sep   => 'a',
 742             #        },
 743             {
 744                 idx   => 'su-geo',
 745                 label => 'Places',
 746                 tags  => [ qw/ 651a / ],
 747                 sep   => '--',
 748             },
 749             {
 750                 idx   => 'su-ut',
 751                 label => 'Titles',
 752                 tags  => [ qw/ 630a / ],
 753                 sep   => '--',
 754             },
 755             {
 756                 idx   => 'au',
 757                 label => 'Authors',
 758                 tags  => [ qw/ 100a 110a 700a / ],
 759                 sep   => ', ',
 760             },
 761             {
 762                 idx   => 'se',
 763                 label => 'Series',
 764                 tags  => [ qw/ 440a 490a / ],
 765                 sep   => ', ',
 766             },
 767             {
 768                 idx   => 'itype',
 769                 label => 'ItemTypes',
 770                 tags  => [ qw/ 952y 942c / ],
 771                 sep   => ', ',
 772             },
 773             ];
 774
 775             my $library_facet;
 776             unless ( C4::Context->preference("singleBranchMode") || GetBranchesCount() == 1 ) {
 777                 $library_facet = {
 778                     idx  => 'branch',
 779                     label => 'Libraries',
 780                     tags        => [ qw / 952b / ],
 781                 };
 782             } else {
 783                 $library_facet = {
 784                     idx => 'location',
 785                     label => 'Location',
 786                     tags => [ qw / 952c / ],
 787                 };
 788             }
 789             push( @$facets, $library_facet );
 790     }
 791     return $facets;
 792 }
 793
 794 =head2 get_infos_of
 795
 796 Return a href where a key is associated to a href. You give a query,
 797 the name of the key among the fields returned by the query. If you
 798 also give as third argument the name of the value, the function
 799 returns a href of scalar. The optional 4th argument is an arrayref of
 800 items passed to the C<execute()> call. It is designed to bind
 801 parameters to any placeholders in your SQL.
 802
 803   my $query = '
 804 SELECT itemnumber,
 805        notforloan,
 806        barcode
 807   FROM items
 808 ';
 809
 810   # generic href of any information on the item, href of href.
 811   my $iteminfos_of = get_infos_of($query, 'itemnumber');
 812   print $iteminfos_of->{$itemnumber}{barcode};
 813
 814   # specific information, href of scalar
 815   my $barcode_of_item = get_infos_of($query, 'itemnumber', 'barcode');
 816   print $barcode_of_item->{$itemnumber};
 817
 818 =cut
 819
 820 sub get_infos_of {
 821     my ( $query, $key_name, $value_name, $bind_params ) = @_;
 822
 823     my $dbh = C4::Context->dbh;
 824
 825     my $sth = $dbh->prepare($query);
 826     $sth->execute( @$bind_params );
 827
 828     my %infos_of;
 829     while ( my $row = $sth->fetchrow_hashref ) {
 830         if ( defined $value_name ) {
 831             $infos_of{ $row->{$key_name} } = $row->{$value_name};
 832         }
 833         else {
 834             $infos_of{ $row->{$key_name} } = $row;
 835         }
 836     }
 837     $sth->finish;
 838
 839     return \%infos_of;
 840 }
 841
 842 =head2 get_notforloan_label_of
 843
 844   my $notforloan_label_of = get_notforloan_label_of();
 845
 846 Each authorised value of notforloan (information available in items and
 847 itemtypes) is link to a single label.
 848
 849 Returns a href where keys are authorised values and values are corresponding
 850 labels.
 851
 852   foreach my $authorised_value (keys %{$notforloan_label_of}) {
 853     printf(
 854         "authorised_value: %s => %s\n",
 855         $authorised_value,
 856         $notforloan_label_of->{$authorised_value}
 857     );
 858   }
 859
 860 =cut
 861
 862 # FIXME - why not use GetAuthorisedValues ??
 863 #
 864 sub get_notforloan_label_of {
 865     my $dbh = C4::Context->dbh;
 866
 867     my $query = '
 868 SELECT authorised_value
 869   FROM marc_subfield_structure
 870   WHERE kohafield = \'items.notforloan\'
 871   LIMIT 0, 1
 872 ';
 873     my $sth = $dbh->prepare($query);
 874     $sth->execute();
 875     my ($statuscode) = $sth->fetchrow_array();
 876
 877     $query = '
 878 SELECT lib,
 879        authorised_value
 880   FROM authorised_values
 881   WHERE category = ?
 882 ';
 883     $sth = $dbh->prepare($query);
 884     $sth->execute($statuscode);
 885     my %notforloan_label_of;
 886     while ( my $row = $sth->fetchrow_hashref ) {
 887         $notforloan_label_of{ $row->{authorised_value} } = $row->{lib};
 888     }
 889     $sth->finish;
 890
 891     return \%notforloan_label_of;
 892 }
 893
 894 =head2 displayServers
 895
 896    my $servers = displayServers();
 897    my $servers = displayServers( $position );
 898    my $servers = displayServers( $position, $type );
 899
 900 displayServers returns a listref of hashrefs, each containing
 901 information about available z3950 servers. Each hashref has a format
 902 like:
 903
 904     {
 905       'checked'    => 'checked',
 906       'encoding'   => 'utf8',
 907       'icon'       => undef,
 908       'id'         => 'LIBRARY OF CONGRESS',
 909       'label'      => '',
 910       'name'       => 'server',
 911       'opensearch' => '',
 912       'value'      => 'lx2.loc.gov:210/',
 913       'zed'        => 1,
 914     },
 915
 916 =cut
 917
 918 sub displayServers {
 919     my ( $position, $type ) = @_;
 920     my $dbh = C4::Context->dbh;
 921
 922     my $strsth = 'SELECT * FROM z3950servers';
 923     my @where_clauses;
 924     my @bind_params;
 925
 926     if ($position) {
 927         push @bind_params,   $position;
 928         push @where_clauses, ' position = ? ';
 929     }
 930
 931     if ($type) {
 932         push @bind_params,   $type;
 933         push @where_clauses, ' type = ? ';
 934     }
 935
 936     # reassemble where clause from where clause pieces
 937     if (@where_clauses) {
 938         $strsth .= ' WHERE ' . join( ' AND ', @where_clauses );
 939     }
 940
 941     my $rq = $dbh->prepare($strsth);
 942     $rq->execute(@bind_params);
 943     my @primaryserverloop;
 944
 945     while ( my $data = $rq->fetchrow_hashref ) {
 946         push @primaryserverloop,
 947           { label    => $data->{description},
 948             id       => $data->{name},
 949             name     => "server",
 950             value    => $data->{host} . ":" . $data->{port} . "/" . $data->{database},
 951             encoding => ( $data->{encoding} ? $data->{encoding} : "iso-5426" ),
 952             checked  => "checked",
 953             icon     => $data->{icon},
 954             zed        => $data->{type} eq 'zed',
 955             opensearch => $data->{type} eq 'opensearch'
 956           };
 957     }
 958     return \@primaryserverloop;
 959 }
 960
 961
 962 =head2 GetKohaImageurlFromAuthorisedValues
 963
 964 $authhorised_value = GetKohaImageurlFromAuthorisedValues( $category, $authvalcode );
 965
 966 Return the first url of the authorised value image represented by $lib.
 967
 968 =cut
 969
 970 sub GetKohaImageurlFromAuthorisedValues {
 971     my ( $category, $lib ) = @_;
 972     my $dbh = C4::Context->dbh;
 973     my $sth = $dbh->prepare("SELECT imageurl FROM authorised_values WHERE category=? AND lib =?");
 974     $sth->execute( $category, $lib );
 975     while ( my $data = $sth->fetchrow_hashref ) {
 976         return $data->{'imageurl'};
 977     }
 978 }
 979
 980 =head2 GetAuthValCode
 981
 982   $authvalcode = GetAuthValCode($kohafield,$frameworkcode);
 983
 984 =cut
 985
 986 sub GetAuthValCode {
 987         my ($kohafield,$fwcode) = @_;
 988         my $dbh = C4::Context->dbh;
 989         $fwcode='' unless $fwcode;
 990         my $sth = $dbh->prepare('select authorised_value from marc_subfield_structure where kohafield=? and frameworkcode=?');
 991         $sth->execute($kohafield,$fwcode);
 992         my ($authvalcode) = $sth->fetchrow_array;
 993         return $authvalcode;
 994 }
 995
 996 =head2 GetAuthValCodeFromField
 997
 998   $authvalcode = GetAuthValCodeFromField($field,$subfield,$frameworkcode);
 999
1000 C<$subfield> can be undefined
1001
1002 =cut
1003
1004 sub GetAuthValCodeFromField {
1005         my ($field,$subfield,$fwcode) = @_;
1006         my $dbh = C4::Context->dbh;
1007         $fwcode='' unless $fwcode;
1008         my $sth;
1009         if (defined $subfield) {
1010             $sth = $dbh->prepare('select authorised_value from marc_subfield_structure where tagfield=? and tagsubfield=? and frameworkcode=?');
1011             $sth->execute($field,$subfield,$fwcode);
1012         } else {
1013             $sth = $dbh->prepare('select authorised_value from marc_tag_structure where tagfield=? and frameworkcode=?');
1014             $sth->execute($field,$fwcode);
1015         }
1016         my ($authvalcode) = $sth->fetchrow_array;
1017         return $authvalcode;
1018 }
1019
1020 =head2 GetAuthorisedValues
1021
1022   $authvalues = GetAuthorisedValues([$category], [$selected]);
1023
1024 This function returns all authorised values from the'authorised_value' table in a reference to array of hashrefs.
1025
1026 C<$category> returns authorised values for just one category (optional).
1027
1028 C<$opac> If set to a true value, displays OPAC descriptions rather than normal ones when they exist.
1029
1030 =cut
1031
1032 sub GetAuthorisedValues {
1033     my ( $category, $selected, $opac ) = @_;
1034     my $branch_limit = C4::Context->userenv ? C4::Context->userenv->{"branch"} : "";
1035     my @results;
1036     my $dbh      = C4::Context->dbh;
1037     my $query = qq{
1038         SELECT *
1039         FROM authorised_values
1040     };
1041     $query .= qq{
1042           LEFT JOIN authorised_values_branches ON ( id = av_id )
1043     } if $branch_limit;
1044     my @where_strings;
1045     my @where_args;
1046     if($category) {
1047         push @where_strings, "category = ?";
1048         push @where_args, $category;
1049     }
1050     if($branch_limit) {
1051         push @where_strings, "( branchcode = ? OR branchcode IS NULL )";
1052         push @where_args, $branch_limit;
1053     }
1054     if(@where_strings > 0) {
1055         $query .= " WHERE " . join(" AND ", @where_strings);
1056     }
1057     $query .= " GROUP BY lib";
1058     $query .= ' ORDER BY category, ' . (
1059                 $opac ? 'COALESCE(lib_opac, lib)'
1060                       : 'lib, lib_opac'
1061               );
1062
1063     my $sth = $dbh->prepare($query);
1064
1065     $sth->execute( @where_args );
1066     while (my $data=$sth->fetchrow_hashref) {
1067         if ( defined $selected and $selected eq $data->{authorised_value} ) {
1068             $data->{selected} = 1;
1069         }
1070         else {
1071             $data->{selected} = 0;
1072         }
1073
1074         if ($opac && $data->{lib_opac}) {
1075             $data->{lib} = $data->{lib_opac};
1076         }
1077         push @results, $data;
1078     }
1079     $sth->finish;
1080     return \@results;
1081 }
1082
1083 =head2 GetAuthorisedValueCategories
1084
1085   $auth_categories = GetAuthorisedValueCategories();
1086
1087 Return an arrayref of all of the available authorised
1088 value categories.
1089
1090 =cut
1091
1092 sub GetAuthorisedValueCategories {
1093     my $dbh = C4::Context->dbh;
1094     my $sth = $dbh->prepare("SELECT DISTINCT category FROM authorised_values ORDER BY category");
1095     $sth->execute;
1096     my @results;
1097     while (defined (my $category  = $sth->fetchrow_array) ) {
1098         push @results, $category;
1099     }
1100     return \@results;
1101 }
1102
1103 =head2 IsAuthorisedValueCategory
1104
1105     $is_auth_val_category = IsAuthorisedValueCategory($category);
1106
1107 Returns whether a given category name is a valid one
1108
1109 =cut
1110
1111 sub IsAuthorisedValueCategory {
1112     my $category = shift;
1113     my $query = '
1114         SELECT category
1115         FROM authorised_values
1116         WHERE BINARY category=?
1117         LIMIT 1
1118     ';
1119     my $sth = C4::Context->dbh->prepare($query);
1120     $sth->execute($category);
1121     $sth->fetchrow ? return 1
1122                    : return 0;
1123 }
1124
1125 =head2 GetAuthorisedValueByCode
1126
1127 $authorised_value = GetAuthorisedValueByCode( $category, $authvalcode, $opac );
1128
1129 Return the lib attribute from authorised_values from the row identified
1130 by the passed category and code
1131
1132 =cut
1133
1134 sub GetAuthorisedValueByCode {
1135     my ( $category, $authvalcode, $opac ) = @_;
1136
1137     my $field = $opac ? 'lib_opac' : 'lib';
1138     my $dbh = C4::Context->dbh;
1139     my $sth = $dbh->prepare("SELECT $field FROM authorised_values WHERE category=? AND authorised_value =?");
1140     $sth->execute( $category, $authvalcode );
1141     while ( my $data = $sth->fetchrow_hashref ) {
1142         return $data->{ $field };
1143     }
1144 }
1145
1146 =head2 GetKohaAuthorisedValues
1147
1148 Takes $kohafield, $fwcode as parameters.
1149
1150 If $opac parameter is set to a true value, displays OPAC descriptions rather than normal ones when they exist.
1151
1152 Returns hashref of Code => description
1153
1154 Returns undef if no authorised value category is defined for the kohafield.
1155
1156 =cut
1157
1158 sub GetKohaAuthorisedValues {
1159   my ($kohafield,$fwcode,$opac) = @_;
1160   $fwcode='' unless $fwcode;
1161   my %values;
1162   my $dbh = C4::Context->dbh;
1163   my $avcode = GetAuthValCode($kohafield,$fwcode);
1164   if ($avcode) {
1165         my $sth = $dbh->prepare("select authorised_value, lib, lib_opac from authorised_values where category=? ");
1166         $sth->execute($avcode);
1167         while ( my ($val, $lib, $lib_opac) = $sth->fetchrow_array ) {
1168                 $values{$val} = ($opac && $lib_opac) ? $lib_opac : $lib;
1169         }
1170         return \%values;
1171   } else {
1172         return;
1173   }
1174 }
1175
1176 =head2 GetKohaAuthorisedValuesFromField
1177
1178 Takes $field, $subfield, $fwcode as parameters.
1179
1180 If $opac parameter is set to a true value, displays OPAC descriptions rather than normal ones when they exist.
1181 $subfield can be undefined
1182
1183 Returns hashref of Code => description
1184
1185 Returns undef if no authorised value category is defined for the given field and subfield
1186
1187 =cut
1188
1189 sub GetKohaAuthorisedValuesFromField {
1190   my ($field, $subfield, $fwcode,$opac) = @_;
1191   $fwcode='' unless $fwcode;
1192   my %values;
1193   my $dbh = C4::Context->dbh;
1194   my $avcode = GetAuthValCodeFromField($field, $subfield, $fwcode);
1195   if ($avcode) {
1196         my $sth = $dbh->prepare("select authorised_value, lib, lib_opac from authorised_values where category=? ");
1197         $sth->execute($avcode);
1198         while ( my ($val, $lib, $lib_opac) = $sth->fetchrow_array ) {
1199                 $values{$val} = ($opac && $lib_opac) ? $lib_opac : $lib;
1200         }
1201         return \%values;
1202   } else {
1203         return;
1204   }
1205 }
1206
1207 =head2 xml_escape
1208
1209   my $escaped_string = C4::Koha::xml_escape($string);
1210
1211 Convert &, <, >, ', and " in a string to XML entities
1212
1213 =cut
1214
1215 sub xml_escape {
1216     my $str = shift;
1217     return '' unless defined $str;
1218     $str =~ s/&/&amp;/g;
1219     $str =~ s/</&lt;/g;
1220     $str =~ s/>/&gt;/g;
1221     $str =~ s/'/&apos;/g;
1222     $str =~ s/"/&quot;/g;
1223     return $str;
1224 }
1225
1226 =head2 GetKohaAuthorisedValueLib
1227
1228 Takes $category, $authorised_value as parameters.
1229
1230 If $opac parameter is set to a true value, displays OPAC descriptions rather than normal ones when they exist.
1231
1232 Returns authorised value description
1233
1234 =cut
1235
1236 sub GetKohaAuthorisedValueLib {
1237   my ($category,$authorised_value,$opac) = @_;
1238   my $value;
1239   my $dbh = C4::Context->dbh;
1240   my $sth = $dbh->prepare("select lib, lib_opac from authorised_values where category=? and authorised_value=?");
1241   $sth->execute($category,$authorised_value);
1242   my $data = $sth->fetchrow_hashref;
1243   $value = ($opac && $$data{'lib_opac'}) ? $$data{'lib_opac'} : $$data{'lib'};
1244   return $value;
1245 }
1246
1247 =head2 AddAuthorisedValue
1248
1249     AddAuthorisedValue($category, $authorised_value, $lib, $lib_opac, $imageurl);
1250
1251 Create a new authorised value.
1252
1253 =cut
1254
1255 sub AddAuthorisedValue {
1256     my ($category, $authorised_value, $lib, $lib_opac, $imageurl) = @_;
1257
1258     my $dbh = C4::Context->dbh;
1259     my $query = qq{
1260         INSERT INTO authorised_values (category, authorised_value, lib, lib_opac, imageurl)
1261         VALUES (?,?,?,?,?)
1262     };
1263     my $sth = $dbh->prepare($query);
1264     $sth->execute($category, $authorised_value, $lib, $lib_opac, $imageurl);
1265 }
1266
1267 =head2 display_marc_indicators
1268
1269   my $display_form = C4::Koha::display_marc_indicators($field);
1270
1271 C<$field> is a MARC::Field object
1272
1273 Generate a display form of the indicators of a variable
1274 MARC field, replacing any blanks with '#'.
1275
1276 =cut
1277
1278 sub display_marc_indicators {
1279     my $field = shift;
1280     my $indicators = '';
1281     if ($field->tag() >= 10) {
1282         $indicators = $field->indicator(1) . $field->indicator(2);
1283         $indicators =~ s/ /#/g;
1284     }
1285     return $indicators;
1286 }
1287
1288 sub GetNormalizedUPC {
1289  my ($record,$marcflavour) = @_;
1290     my (@fields,$upc);
1291
1292     if ($marcflavour eq 'UNIMARC') {
1293         @fields = $record->field('072');
1294         foreach my $field (@fields) {
1295             my $upc = _normalize_match_point($field->subfield('a'));
1296             if ($upc ne '') {
1297                 return $upc;
1298             }
1299         }
1300
1301     }
1302     else { # assume marc21 if not unimarc
1303         @fields = $record->field('024');
1304         foreach my $field (@fields) {
1305             my $indicator = $field->indicator(1);
1306             my $upc = _normalize_match_point($field->subfield('a'));
1307             if ($indicator == 1 and $upc ne '') {
1308                 return $upc;
1309             }
1310         }
1311     }
1312 }
1313
1314 # Normalizes and returns the first valid ISBN found in the record
1315 # ISBN13 are converted into ISBN10. This is required to get some book cover images.
1316 sub GetNormalizedISBN {
1317     my ($isbn,$record,$marcflavour) = @_;
1318     my @fields;
1319     if ($isbn) {
1320         # Koha attempts to store multiple ISBNs in biblioitems.isbn, separated by " | "
1321         # anything after " | " should be removed, along with the delimiter
1322         $isbn =~ s/(.*)( \| )(.*)/$1/;
1323         return _isbn_cleanup($isbn);
1324     }
1325     return unless $record;
1326
1327     if ($marcflavour eq 'UNIMARC') {
1328         @fields = $record->field('010');
1329         foreach my $field (@fields) {
1330             my $isbn = $field->subfield('a');
1331             if ($isbn) {
1332                 return _isbn_cleanup($isbn);
1333             } else {
1334                 return;
1335             }
1336         }
1337     }
1338     else { # assume marc21 if not unimarc
1339         @fields = $record->field('020');
1340         foreach my $field (@fields) {
1341             $isbn = $field->subfield('a');
1342             if ($isbn) {
1343                 return _isbn_cleanup($isbn);
1344             } else {
1345                 return;
1346             }
1347         }
1348     }
1349 }
1350
1351 sub GetNormalizedEAN {
1352     my ($record,$marcflavour) = @_;
1353     my (@fields,$ean);
1354
1355     if ($marcflavour eq 'UNIMARC') {
1356         @fields = $record->field('073');
1357         foreach my $field (@fields) {
1358             $ean = _normalize_match_point($field->subfield('a'));
1359             if ($ean ne '') {
1360                 return $ean;
1361             }
1362         }
1363     }
1364     else { # assume marc21 if not unimarc
1365         @fields = $record->field('024');
1366         foreach my $field (@fields) {
1367             my $indicator = $field->indicator(1);
1368             $ean = _normalize_match_point($field->subfield('a'));
1369             if ($indicator == 3 and $ean ne '') {
1370                 return $ean;
1371             }
1372         }
1373     }
1374 }
1375 sub GetNormalizedOCLCNumber {
1376     my ($record,$marcflavour) = @_;
1377     my (@fields,$oclc);
1378
1379     if ($marcflavour eq 'UNIMARC') {
1380         # TODO: add UNIMARC fields
1381     }
1382     else { # assume marc21 if not unimarc
1383         @fields = $record->field('035');
1384         foreach my $field (@fields) {
1385             $oclc = $field->subfield('a');
1386             if ($oclc =~ /OCoLC/) {
1387                 $oclc =~ s/\(OCoLC\)//;
1388                 return $oclc;
1389             } else {
1390                 return;
1391             }
1392         }
1393     }
1394 }
1395
1396 =head2 GetDailyQuote($opts)
1397
1398 Takes a hashref of options
1399
1400 Currently supported options are:
1401
1402 'id'        An exact quote id
1403 'random'    Select a random quote
1404 noop        When no option is passed in, this sub will return the quote timestamped for the current day
1405
1406 The function returns an anonymous hash following this format:
1407
1408         {
1409           'source' => 'source-of-quote',
1410           'timestamp' => 'timestamp-value',
1411           'text' => 'text-of-quote',
1412           'id' => 'quote-id'
1413         };
1414
1415 =cut
1416
1417 # This is definitely a candidate for some sort of caching once we finally settle caching/persistence issues...
1418 # at least for default option
1419
1420 sub GetDailyQuote {
1421     my %opts = @_;
1422     my $dbh = C4::Context->dbh;
1423     my $query = '';
1424     my $sth = undef;
1425     my $quote = undef;
1426     if ($opts{'id'}) {
1427         $query = 'SELECT * FROM quotes WHERE id = ?';
1428         $sth = $dbh->prepare($query);
1429         $sth->execute($opts{'id'});
1430         $quote = $sth->fetchrow_hashref();
1431     }
1432     elsif ($opts{'random'}) {
1433         # Fall through... we also return a random quote as a catch-all if all else fails
1434     }
1435     else {
1436         $query = 'SELECT * FROM quotes WHERE timestamp LIKE CONCAT(CURRENT_DATE,\'%\') ORDER BY timestamp DESC LIMIT 0,1';
1437         $sth = $dbh->prepare($query);
1438         $sth->execute();
1439         $quote = $sth->fetchrow_hashref();
1440     }
1441     unless ($quote) {        # if there are not matches, choose a random quote
1442         # get a list of all available quote ids
1443         $sth = C4::Context->dbh->prepare('SELECT count(*) FROM quotes;');
1444         $sth->execute;
1445         my $range = ($sth->fetchrow_array)[0];
1446         if ($range > 1) {
1447             # chose a random id within that range if there is more than one quote
1448             my $id = int(rand($range));
1449             # grab it
1450             $query = 'SELECT * FROM quotes WHERE id = ?;';
1451             $sth = C4::Context->dbh->prepare($query);
1452             $sth->execute($id);
1453         }
1454         else {
1455             $query = 'SELECT * FROM quotes;';
1456             $sth = C4::Context->dbh->prepare($query);
1457             $sth->execute();
1458         }
1459         $quote = $sth->fetchrow_hashref();
1460         # update the timestamp for that quote
1461         $query = 'UPDATE quotes SET timestamp = ? WHERE id = ?';
1462         $sth = C4::Context->dbh->prepare($query);
1463         $sth->execute(
1464             DateTime::Format::MySQL->format_datetime( dt_from_string() ),
1465             $quote->{'id'}
1466         );
1467     }
1468     return $quote;
1469 }
1470
1471 sub _normalize_match_point {
1472     my $match_point = shift;
1473     (my $normalized_match_point) = $match_point =~ /([\d-]*[X]*)/;
1474     $normalized_match_point =~ s/-//g;
1475
1476     return $normalized_match_point;
1477 }
1478
1479 sub _isbn_cleanup {
1480     require Business::ISBN;
1481     my $isbn = Business::ISBN->new( $_[0] );
1482     if ( $isbn ) {
1483         $isbn = $isbn->as_isbn10 if $isbn->type eq 'ISBN13';
1484         if (defined $isbn) {
1485             return $isbn->as_string([]);
1486         }
1487     }
1488     return;
1489 }
1490
1491 1;
1492
1493 __END__
1494
1495 =head1 AUTHOR
1496
1497 Koha Team
1498
1499 =cut