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