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