C4/Koha.pm

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