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