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