C4/Koha.pm

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