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