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