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