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