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