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 Memoize;
  29 use DateTime;
  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     <form action='<!-- TMPL_VAR name="script_name" -->' method=post>
 178         <select name="itemtype">
 179             <option value="">Default</option>
 180         <!-- TMPL_LOOP name="itemtypeloop" -->
 181             <option value="<!-- TMPL_VAR name="itemtype" -->" <!-- TMPL_IF name="selected" -->selected<!-- /TMPL_IF -->> <!--TMPL_IF Name="imageurl"--><img alt="<!-- TMPL_VAR name="description" -->" src="<!--TMPL_VAR Name="imageurl"-->><!--TMPL_ELSE-->"<!-- TMPL_VAR name="description" --><!--/TMPL_IF--></option>
 182         <!-- /TMPL_LOOP -->
 183         </select>
 184         <input type=text name=searchfield value="<!-- TMPL_VAR name="searchfield" -->">
 185         <input type="submit" value="OK" class="button">
 186     </form>
 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 ORDER BY category, lib, lib_opac";
1068
1069     my $sth = $dbh->prepare($query);
1070
1071     $sth->execute( @where_args );
1072     while (my $data=$sth->fetchrow_hashref) {
1073         if ( defined $selected and $selected eq $data->{authorised_value} ) {
1074             $data->{selected} = 1;
1075         }
1076         else {
1077             $data->{selected} = 0;
1078         }
1079
1080         if ($opac && $data->{lib_opac}) {
1081             $data->{lib} = $data->{lib_opac};
1082         }
1083         push @results, $data;
1084     }
1085     $sth->finish;
1086     return \@results;
1087 }
1088
1089 =head2 GetAuthorisedValueCategories
1090
1091   $auth_categories = GetAuthorisedValueCategories();
1092
1093 Return an arrayref of all of the available authorised
1094 value categories.
1095
1096 =cut
1097
1098 sub GetAuthorisedValueCategories {
1099     my $dbh = C4::Context->dbh;
1100     my $sth = $dbh->prepare("SELECT DISTINCT category FROM authorised_values ORDER BY category");
1101     $sth->execute;
1102     my @results;
1103     while (defined (my $category  = $sth->fetchrow_array) ) {
1104         push @results, $category;
1105     }
1106     return \@results;
1107 }
1108
1109 =head2 IsAuthorisedValueCategory
1110
1111     $is_auth_val_category = IsAuthorisedValueCategory($category);
1112
1113 Returns whether a given category name is a valid one
1114
1115 =cut
1116
1117 sub IsAuthorisedValueCategory {
1118     my $category = shift;
1119     my $query = '
1120         SELECT category
1121         FROM authorised_values
1122         WHERE BINARY category=?
1123         LIMIT 1
1124     ';
1125     my $sth = C4::Context->dbh->prepare($query);
1126     $sth->execute($category);
1127     $sth->fetchrow ? return 1
1128                    : return 0;
1129 }
1130
1131 =head2 GetAuthorisedValueByCode
1132
1133 $authhorised_value = GetAuthorisedValueByCode( $category, $authvalcode );
1134
1135 Return the lib attribute from authorised_values from the row identified
1136 by the passed category and code
1137
1138 =cut
1139
1140 sub GetAuthorisedValueByCode {
1141     my ( $category, $authvalcode, $opac ) = @_;
1142
1143     my $field = $opac ? 'lib_opac' : 'lib';
1144     my $dbh = C4::Context->dbh;
1145     my $sth = $dbh->prepare("SELECT $field FROM authorised_values WHERE category=? AND authorised_value =?");
1146     $sth->execute( $category, $authvalcode );
1147     while ( my $data = $sth->fetchrow_hashref ) {
1148         return $data->{ $field };
1149     }
1150 }
1151
1152 =head2 GetKohaAuthorisedValues
1153
1154 Takes $kohafield, $fwcode as parameters.
1155
1156 If $opac parameter is set to a true value, displays OPAC descriptions rather than normal ones when they exist.
1157
1158 Returns hashref of Code => description
1159
1160 Returns undef if no authorised value category is defined for the kohafield.
1161
1162 =cut
1163
1164 sub GetKohaAuthorisedValues {
1165   my ($kohafield,$fwcode,$opac) = @_;
1166   $fwcode='' unless $fwcode;
1167   my %values;
1168   my $dbh = C4::Context->dbh;
1169   my $avcode = GetAuthValCode($kohafield,$fwcode);
1170   if ($avcode) {
1171         my $sth = $dbh->prepare("select authorised_value, lib, lib_opac from authorised_values where category=? ");
1172         $sth->execute($avcode);
1173         while ( my ($val, $lib, $lib_opac) = $sth->fetchrow_array ) {
1174                 $values{$val} = ($opac && $lib_opac) ? $lib_opac : $lib;
1175         }
1176         return \%values;
1177   } else {
1178         return;
1179   }
1180 }
1181
1182 =head2 GetKohaAuthorisedValuesFromField
1183
1184 Takes $field, $subfield, $fwcode as parameters.
1185
1186 If $opac parameter is set to a true value, displays OPAC descriptions rather than normal ones when they exist.
1187 $subfield can be undefined
1188
1189 Returns hashref of Code => description
1190
1191 Returns undef if no authorised value category is defined for the given field and subfield
1192
1193 =cut
1194
1195 sub GetKohaAuthorisedValuesFromField {
1196   my ($field, $subfield, $fwcode,$opac) = @_;
1197   $fwcode='' unless $fwcode;
1198   my %values;
1199   my $dbh = C4::Context->dbh;
1200   my $avcode = GetAuthValCodeFromField($field, $subfield, $fwcode);
1201   if ($avcode) {
1202         my $sth = $dbh->prepare("select authorised_value, lib, lib_opac from authorised_values where category=? ");
1203         $sth->execute($avcode);
1204         while ( my ($val, $lib, $lib_opac) = $sth->fetchrow_array ) {
1205                 $values{$val} = ($opac && $lib_opac) ? $lib_opac : $lib;
1206         }
1207         return \%values;
1208   } else {
1209         return;
1210   }
1211 }
1212
1213 =head2 xml_escape
1214
1215   my $escaped_string = C4::Koha::xml_escape($string);
1216
1217 Convert &, <, >, ', and " in a string to XML entities
1218
1219 =cut
1220
1221 sub xml_escape {
1222     my $str = shift;
1223     return '' unless defined $str;
1224     $str =~ s/&/&amp;/g;
1225     $str =~ s/</&lt;/g;
1226     $str =~ s/>/&gt;/g;
1227     $str =~ s/'/&apos;/g;
1228     $str =~ s/"/&quot;/g;
1229     return $str;
1230 }
1231
1232 =head2 GetKohaAuthorisedValueLib
1233
1234 Takes $category, $authorised_value as parameters.
1235
1236 If $opac parameter is set to a true value, displays OPAC descriptions rather than normal ones when they exist.
1237
1238 Returns authorised value description
1239
1240 =cut
1241
1242 sub GetKohaAuthorisedValueLib {
1243   my ($category,$authorised_value,$opac) = @_;
1244   my $value;
1245   my $dbh = C4::Context->dbh;
1246   my $sth = $dbh->prepare("select lib, lib_opac from authorised_values where category=? and authorised_value=?");
1247   $sth->execute($category,$authorised_value);
1248   my $data = $sth->fetchrow_hashref;
1249   $value = ($opac && $$data{'lib_opac'}) ? $$data{'lib_opac'} : $$data{'lib'};
1250   return $value;
1251 }
1252
1253 =head2 AddAuthorisedValue
1254
1255     AddAuthorisedValue($category, $authorised_value, $lib, $lib_opac, $imageurl);
1256
1257 Create a new authorised value.
1258
1259 =cut
1260
1261 sub AddAuthorisedValue {
1262     my ($category, $authorised_value, $lib, $lib_opac, $imageurl) = @_;
1263
1264     my $dbh = C4::Context->dbh;
1265     my $query = qq{
1266         INSERT INTO authorised_values (category, authorised_value, lib, lib_opac, imageurl)
1267         VALUES (?,?,?,?,?)
1268     };
1269     my $sth = $dbh->prepare($query);
1270     $sth->execute($category, $authorised_value, $lib, $lib_opac, $imageurl);
1271 }
1272
1273 =head2 display_marc_indicators
1274
1275   my $display_form = C4::Koha::display_marc_indicators($field);
1276
1277 C<$field> is a MARC::Field object
1278
1279 Generate a display form of the indicators of a variable
1280 MARC field, replacing any blanks with '#'.
1281
1282 =cut
1283
1284 sub display_marc_indicators {
1285     my $field = shift;
1286     my $indicators = '';
1287     if ($field->tag() >= 10) {
1288         $indicators = $field->indicator(1) . $field->indicator(2);
1289         $indicators =~ s/ /#/g;
1290     }
1291     return $indicators;
1292 }
1293
1294 sub GetNormalizedUPC {
1295  my ($record,$marcflavour) = @_;
1296     my (@fields,$upc);
1297
1298     if ($marcflavour eq 'UNIMARC') {
1299         @fields = $record->field('072');
1300         foreach my $field (@fields) {
1301             my $upc = _normalize_match_point($field->subfield('a'));
1302             if ($upc ne '') {
1303                 return $upc;
1304             }
1305         }
1306
1307     }
1308     else { # assume marc21 if not unimarc
1309         @fields = $record->field('024');
1310         foreach my $field (@fields) {
1311             my $indicator = $field->indicator(1);
1312             my $upc = _normalize_match_point($field->subfield('a'));
1313             if ($indicator == 1 and $upc ne '') {
1314                 return $upc;
1315             }
1316         }
1317     }
1318 }
1319
1320 # Normalizes and returns the first valid ISBN found in the record
1321 # ISBN13 are converted into ISBN10. This is required to get some book cover images.
1322 sub GetNormalizedISBN {
1323     my ($isbn,$record,$marcflavour) = @_;
1324     my @fields;
1325     if ($isbn) {
1326         # Koha attempts to store multiple ISBNs in biblioitems.isbn, separated by " | "
1327         # anything after " | " should be removed, along with the delimiter
1328         $isbn =~ s/(.*)( \| )(.*)/$1/;
1329         return _isbn_cleanup($isbn);
1330     }
1331     return unless $record;
1332
1333     if ($marcflavour eq 'UNIMARC') {
1334         @fields = $record->field('010');
1335         foreach my $field (@fields) {
1336             my $isbn = $field->subfield('a');
1337             if ($isbn) {
1338                 return _isbn_cleanup($isbn);
1339             } else {
1340                 return;
1341             }
1342         }
1343     }
1344     else { # assume marc21 if not unimarc
1345         @fields = $record->field('020');
1346         foreach my $field (@fields) {
1347             $isbn = $field->subfield('a');
1348             if ($isbn) {
1349                 return _isbn_cleanup($isbn);
1350             } else {
1351                 return;
1352             }
1353         }
1354     }
1355 }
1356
1357 sub GetNormalizedEAN {
1358     my ($record,$marcflavour) = @_;
1359     my (@fields,$ean);
1360
1361     if ($marcflavour eq 'UNIMARC') {
1362         @fields = $record->field('073');
1363         foreach my $field (@fields) {
1364             $ean = _normalize_match_point($field->subfield('a'));
1365             if ($ean ne '') {
1366                 return $ean;
1367             }
1368         }
1369     }
1370     else { # assume marc21 if not unimarc
1371         @fields = $record->field('024');
1372         foreach my $field (@fields) {
1373             my $indicator = $field->indicator(1);
1374             $ean = _normalize_match_point($field->subfield('a'));
1375             if ($indicator == 3 and $ean ne '') {
1376                 return $ean;
1377             }
1378         }
1379     }
1380 }
1381 sub GetNormalizedOCLCNumber {
1382     my ($record,$marcflavour) = @_;
1383     my (@fields,$oclc);
1384
1385     if ($marcflavour eq 'UNIMARC') {
1386         # TODO: add UNIMARC fields
1387     }
1388     else { # assume marc21 if not unimarc
1389         @fields = $record->field('035');
1390         foreach my $field (@fields) {
1391             $oclc = $field->subfield('a');
1392             if ($oclc =~ /OCoLC/) {
1393                 $oclc =~ s/\(OCoLC\)//;
1394                 return $oclc;
1395             } else {
1396                 return;
1397             }
1398         }
1399     }
1400 }
1401
1402 =head2 GetDailyQuote($opts)
1403
1404 Takes a hashref of options
1405
1406 Currently supported options are:
1407
1408 'id'        An exact quote id
1409 'random'    Select a random quote
1410 noop        When no option is passed in, this sub will return the quote timestamped for the current day
1411
1412 The function returns an anonymous hash following this format:
1413
1414         {
1415           'source' => 'source-of-quote',
1416           'timestamp' => 'timestamp-value',
1417           'text' => 'text-of-quote',
1418           'id' => 'quote-id'
1419         };
1420
1421 =cut
1422
1423 # This is definitely a candidate for some sort of caching once we finally settle caching/persistence issues...
1424 # at least for default option
1425
1426 sub GetDailyQuote {
1427     my %opts = @_;
1428     my $dbh = C4::Context->dbh;
1429     my $query = '';
1430     my $sth = undef;
1431     my $quote = undef;
1432     if ($opts{'id'}) {
1433         $query = 'SELECT * FROM quotes WHERE id = ?';
1434         $sth = $dbh->prepare($query);
1435         $sth->execute($opts{'id'});
1436         $quote = $sth->fetchrow_hashref();
1437     }
1438     elsif ($opts{'random'}) {
1439         # Fall through... we also return a random quote as a catch-all if all else fails
1440     }
1441     else {
1442         $query = 'SELECT * FROM quotes WHERE timestamp LIKE CONCAT(CURRENT_DATE,\'%\') ORDER BY timestamp DESC LIMIT 0,1';
1443         $sth = $dbh->prepare($query);
1444         $sth->execute();
1445         $quote = $sth->fetchrow_hashref();
1446     }
1447     unless ($quote) {        # if there are not matches, choose a random quote
1448         # get a list of all available quote ids
1449         $sth = C4::Context->dbh->prepare('SELECT count(*) FROM quotes;');
1450         $sth->execute;
1451         my $range = ($sth->fetchrow_array)[0];
1452         if ($range > 1) {
1453             # chose a random id within that range if there is more than one quote
1454             my $id = int(rand($range));
1455             # grab it
1456             $query = 'SELECT * FROM quotes WHERE id = ?;';
1457             $sth = C4::Context->dbh->prepare($query);
1458             $sth->execute($id);
1459         }
1460         else {
1461             $query = 'SELECT * FROM quotes;';
1462             $sth = C4::Context->dbh->prepare($query);
1463             $sth->execute();
1464         }
1465         $quote = $sth->fetchrow_hashref();
1466         # update the timestamp for that quote
1467         $query = 'UPDATE quotes SET timestamp = ? WHERE id = ?';
1468         $sth = C4::Context->dbh->prepare($query);
1469         $sth->execute(DateTime::Format::MySQL->format_datetime(DateTime->now), $quote->{'id'});
1470     }
1471     return $quote;
1472 }
1473
1474 sub _normalize_match_point {
1475     my $match_point = shift;
1476     (my $normalized_match_point) = $match_point =~ /([\d-]*[X]*)/;
1477     $normalized_match_point =~ s/-//g;
1478
1479     return $normalized_match_point;
1480 }
1481
1482 sub _isbn_cleanup {
1483     require Business::ISBN;
1484     my $isbn = Business::ISBN->new( $_[0] );
1485     if ( $isbn ) {
1486         $isbn = $isbn->as_isbn10 if $isbn->type eq 'ISBN13';
1487         if (defined $isbn) {
1488             return $isbn->as_string([]);
1489         }
1490     }
1491     return;
1492 }
1493
1494 1;
1495
1496 __END__
1497
1498 =head1 AUTHOR
1499
1500 Koha Team
1501
1502 =cut