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