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 %itemtypes;
 254     my $dbh   = C4::Context->dbh;
 255     my $query = q|
 256         SELECT
 257                itemtypes.itemtype,
 258                itemtypes.description,
 259                itemtypes.rentalcharge,
 260                itemtypes.notforloan,
 261                itemtypes.imageurl,
 262                itemtypes.summary,
 263                itemtypes.checkinmsg,
 264                itemtypes.checkinmsgtype,
 265                itemtypes.sip_media_type,
 266                itemtypes.hideinopac,
 267                itemtypes.searchcategory,
 268                COALESCE( localization.translation, itemtypes.description ) AS translated_description
 269         FROM   itemtypes
 270         LEFT JOIN localization ON itemtypes.itemtype = localization.code
 271             AND localization.entity = 'itemtypes'
 272             AND localization.lang = ?
 273         ORDER BY itemtype
 274     |;
 275     my $sth = $dbh->prepare($query);
 276     $sth->execute( $language );
 277
 278     if ( $style eq 'hash' ) {
 279         while ( my $IT = $sth->fetchrow_hashref ) {
 280             $itemtypes{ $IT->{'itemtype'} } = $IT;
 281         }
 282         return ( \%itemtypes );
 283     } else {
 284         return $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 *
1240         FROM authorised_values
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 .= " GROUP BY lib";
1259     $query .= ' ORDER BY category, ' . (
1260                 $opac ? 'COALESCE(lib_opac, lib)'
1261                       : 'lib, lib_opac'
1262               );
1263
1264     my $sth = $dbh->prepare($query);
1265
1266     $sth->execute( @where_args );
1267     while (my $data=$sth->fetchrow_hashref) {
1268         if ( defined $selected and $selected eq $data->{authorised_value} ) {
1269             $data->{selected} = 1;
1270         }
1271         else {
1272             $data->{selected} = 0;
1273         }
1274
1275         if ($opac && $data->{lib_opac}) {
1276             $data->{lib} = $data->{lib_opac};
1277         }
1278         push @results, $data;
1279     }
1280     $sth->finish;
1281
1282     # We can't cache for long because of that "selected" thing which
1283     # makes it impossible to clear the cache without iterating through every
1284     # value, which sucks. This'll cover this request, and not a whole lot more.
1285     $cache->set_in_cache( $cache_key, \@results, { deepcopy => 1, expiry => 5 } );
1286     return \@results;
1287 }
1288
1289 =head2 GetAuthorisedValueCategories
1290
1291   $auth_categories = GetAuthorisedValueCategories();
1292
1293 Return an arrayref of all of the available authorised
1294 value categories.
1295
1296 =cut
1297
1298 sub GetAuthorisedValueCategories {
1299     my $dbh = C4::Context->dbh;
1300     my $sth = $dbh->prepare("SELECT DISTINCT category FROM authorised_values ORDER BY category");
1301     $sth->execute;
1302     my @results;
1303     while (defined (my $category  = $sth->fetchrow_array) ) {
1304         push @results, $category;
1305     }
1306     return \@results;
1307 }
1308
1309 =head2 IsAuthorisedValueCategory
1310
1311     $is_auth_val_category = IsAuthorisedValueCategory($category);
1312
1313 Returns whether a given category name is a valid one
1314
1315 =cut
1316
1317 sub IsAuthorisedValueCategory {
1318     my $category = shift;
1319     my $query = '
1320         SELECT category
1321         FROM authorised_values
1322         WHERE category=?
1323         LIMIT 1
1324     ';
1325     my $sth = C4::Context->dbh->prepare($query);
1326     $sth->execute($category);
1327     $sth->fetchrow ? return 1
1328                    : return 0;
1329 }
1330
1331 =head2 GetAuthorisedValueByCode
1332
1333 $authorised_value = GetAuthorisedValueByCode( $category, $authvalcode, $opac );
1334
1335 Return the lib attribute from authorised_values from the row identified
1336 by the passed category and code
1337
1338 =cut
1339
1340 sub GetAuthorisedValueByCode {
1341     my ( $category, $authvalcode, $opac ) = @_;
1342
1343     my $field = $opac ? 'lib_opac' : 'lib';
1344     my $dbh = C4::Context->dbh;
1345     my $sth = $dbh->prepare("SELECT $field FROM authorised_values WHERE category=? AND authorised_value =?");
1346     $sth->execute( $category, $authvalcode );
1347     while ( my $data = $sth->fetchrow_hashref ) {
1348         return $data->{ $field };
1349     }
1350 }
1351
1352 =head2 GetKohaAuthorisedValues
1353
1354 Takes $kohafield, $fwcode as parameters.
1355
1356 If $opac parameter is set to a true value, displays OPAC descriptions rather than normal ones when they exist.
1357
1358 Returns hashref of Code => description
1359
1360 Returns undef if no authorised value category is defined for the kohafield.
1361
1362 =cut
1363
1364 sub GetKohaAuthorisedValues {
1365   my ($kohafield,$fwcode,$opac) = @_;
1366   $fwcode='' unless $fwcode;
1367   my %values;
1368   my $dbh = C4::Context->dbh;
1369   my $avcode = GetAuthValCode($kohafield,$fwcode);
1370   if ($avcode) {
1371         my $sth = $dbh->prepare("select authorised_value, lib, lib_opac from authorised_values where category=? ");
1372         $sth->execute($avcode);
1373         while ( my ($val, $lib, $lib_opac) = $sth->fetchrow_array ) {
1374                 $values{$val} = ($opac && $lib_opac) ? $lib_opac : $lib;
1375         }
1376         return \%values;
1377   } else {
1378         return;
1379   }
1380 }
1381
1382 =head2 GetKohaAuthorisedValuesFromField
1383
1384 Takes $field, $subfield, $fwcode as parameters.
1385
1386 If $opac parameter is set to a true value, displays OPAC descriptions rather than normal ones when they exist.
1387 $subfield can be undefined
1388
1389 Returns hashref of Code => description
1390
1391 Returns undef if no authorised value category is defined for the given field and subfield
1392
1393 =cut
1394
1395 sub GetKohaAuthorisedValuesFromField {
1396   my ($field, $subfield, $fwcode,$opac) = @_;
1397   $fwcode='' unless $fwcode;
1398   my %values;
1399   my $dbh = C4::Context->dbh;
1400   my $avcode = GetAuthValCodeFromField($field, $subfield, $fwcode);
1401   if ($avcode) {
1402         my $sth = $dbh->prepare("select authorised_value, lib, lib_opac from authorised_values where category=? ");
1403         $sth->execute($avcode);
1404         while ( my ($val, $lib, $lib_opac) = $sth->fetchrow_array ) {
1405                 $values{$val} = ($opac && $lib_opac) ? $lib_opac : $lib;
1406         }
1407         return \%values;
1408   } else {
1409         return;
1410   }
1411 }
1412
1413 =head2 GetKohaAuthorisedValuesMapping
1414
1415 Takes a hash as a parameter. The interface key indicates the
1416 description to use in the mapping.
1417
1418 Returns hashref of:
1419  "{kohafield},{frameworkcode},{authorised_value}" => "{description}"
1420 for all the kohafields, frameworkcodes, and authorised values.
1421
1422 Returns undef if nothing is found.
1423
1424 =cut
1425
1426 sub GetKohaAuthorisedValuesMapping {
1427     my ($parameter) = @_;
1428     my $interface = $parameter->{'interface'} // '';
1429
1430     my $query_mapping = q{
1431 SELECT TA.kohafield,TA.authorised_value AS category,
1432        TA.frameworkcode,TB.authorised_value,
1433        IF(TB.lib_opac>'',TB.lib_opac,TB.lib) AS OPAC,
1434        TB.lib AS Intranet,TB.lib_opac
1435 FROM marc_subfield_structure AS TA JOIN
1436      authorised_values as TB ON
1437      TA.authorised_value=TB.category
1438 WHERE TA.kohafield>'' AND TA.authorised_value>'';
1439     };
1440     my $dbh = C4::Context->dbh;
1441     my $sth = $dbh->prepare($query_mapping);
1442     $sth->execute();
1443     my $avmapping;
1444     if ($interface eq 'opac') {
1445         while (my $row = $sth->fetchrow_hashref) {
1446             $avmapping->{$row->{kohafield}.",".$row->{frameworkcode}.",".$row->{authorised_value}} = $row->{OPAC};
1447         }
1448     }
1449     else {
1450         while (my $row = $sth->fetchrow_hashref) {
1451             $avmapping->{$row->{kohafield}.",".$row->{frameworkcode}.",".$row->{authorised_value}} = $row->{Intranet};
1452         }
1453     }
1454     return $avmapping;
1455 }
1456
1457 =head2 xml_escape
1458
1459   my $escaped_string = C4::Koha::xml_escape($string);
1460
1461 Convert &, <, >, ', and " in a string to XML entities
1462
1463 =cut
1464
1465 sub xml_escape {
1466     my $str = shift;
1467     return '' unless defined $str;
1468     $str =~ s/&/&amp;/g;
1469     $str =~ s/</&lt;/g;
1470     $str =~ s/>/&gt;/g;
1471     $str =~ s/'/&apos;/g;
1472     $str =~ s/"/&quot;/g;
1473     return $str;
1474 }
1475
1476 =head2 GetKohaAuthorisedValueLib
1477
1478 Takes $category, $authorised_value as parameters.
1479
1480 If $opac parameter is set to a true value, displays OPAC descriptions rather than normal ones when they exist.
1481
1482 Returns authorised value description
1483
1484 =cut
1485
1486 sub GetKohaAuthorisedValueLib {
1487   my ($category,$authorised_value,$opac) = @_;
1488   my $value;
1489   my $dbh = C4::Context->dbh;
1490   my $sth = $dbh->prepare("select lib, lib_opac from authorised_values where category=? and authorised_value=?");
1491   $sth->execute($category,$authorised_value);
1492   my $data = $sth->fetchrow_hashref;
1493   $value = ($opac && $$data{'lib_opac'}) ? $$data{'lib_opac'} : $$data{'lib'};
1494   return $value;
1495 }
1496
1497 =head2 AddAuthorisedValue
1498
1499     AddAuthorisedValue($category, $authorised_value, $lib, $lib_opac, $imageurl);
1500
1501 Create a new authorised value.
1502
1503 =cut
1504
1505 sub AddAuthorisedValue {
1506     my ($category, $authorised_value, $lib, $lib_opac, $imageurl) = @_;
1507
1508     my $dbh = C4::Context->dbh;
1509     my $query = qq{
1510         INSERT INTO authorised_values (category, authorised_value, lib, lib_opac, imageurl)
1511         VALUES (?,?,?,?,?)
1512     };
1513     my $sth = $dbh->prepare($query);
1514     $sth->execute($category, $authorised_value, $lib, $lib_opac, $imageurl);
1515 }
1516
1517 =head2 display_marc_indicators
1518
1519   my $display_form = C4::Koha::display_marc_indicators($field);
1520
1521 C<$field> is a MARC::Field object
1522
1523 Generate a display form of the indicators of a variable
1524 MARC field, replacing any blanks with '#'.
1525
1526 =cut
1527
1528 sub display_marc_indicators {
1529     my $field = shift;
1530     my $indicators = '';
1531     if ($field->tag() >= 10) {
1532         $indicators = $field->indicator(1) . $field->indicator(2);
1533         $indicators =~ s/ /#/g;
1534     }
1535     return $indicators;
1536 }
1537
1538 sub GetNormalizedUPC {
1539  my ($record,$marcflavour) = @_;
1540     my (@fields,$upc);
1541
1542     if ($marcflavour eq 'UNIMARC') {
1543         @fields = $record->field('072');
1544         foreach my $field (@fields) {
1545             my $upc = _normalize_match_point($field->subfield('a'));
1546             if ($upc ne '') {
1547                 return $upc;
1548             }
1549         }
1550
1551     }
1552     else { # assume marc21 if not unimarc
1553         @fields = $record->field('024');
1554         foreach my $field (@fields) {
1555             my $indicator = $field->indicator(1);
1556             my $upc = _normalize_match_point($field->subfield('a'));
1557             if ($indicator == 1 and $upc ne '') {
1558                 return $upc;
1559             }
1560         }
1561     }
1562 }
1563
1564 # Normalizes and returns the first valid ISBN found in the record
1565 # ISBN13 are converted into ISBN10. This is required to get some book cover images.
1566 sub GetNormalizedISBN {
1567     my ($isbn,$record,$marcflavour) = @_;
1568     my @fields;
1569     if ($isbn) {
1570         # Koha attempts to store multiple ISBNs in biblioitems.isbn, separated by " | "
1571         # anything after " | " should be removed, along with the delimiter
1572         ($isbn) = split(/\|/, $isbn );
1573         return _isbn_cleanup($isbn);
1574     }
1575     return unless $record;
1576
1577     if ($marcflavour eq 'UNIMARC') {
1578         @fields = $record->field('010');
1579         foreach my $field (@fields) {
1580             my $isbn = $field->subfield('a');
1581             if ($isbn) {
1582                 return _isbn_cleanup($isbn);
1583             } else {
1584                 return;
1585             }
1586         }
1587     }
1588     else { # assume marc21 if not unimarc
1589         @fields = $record->field('020');
1590         foreach my $field (@fields) {
1591             $isbn = $field->subfield('a');
1592             if ($isbn) {
1593                 return _isbn_cleanup($isbn);
1594             } else {
1595                 return;
1596             }
1597         }
1598     }
1599 }
1600
1601 sub GetNormalizedEAN {
1602     my ($record,$marcflavour) = @_;
1603     my (@fields,$ean);
1604
1605     if ($marcflavour eq 'UNIMARC') {
1606         @fields = $record->field('073');
1607         foreach my $field (@fields) {
1608             $ean = _normalize_match_point($field->subfield('a'));
1609             if ($ean ne '') {
1610                 return $ean;
1611             }
1612         }
1613     }
1614     else { # assume marc21 if not unimarc
1615         @fields = $record->field('024');
1616         foreach my $field (@fields) {
1617             my $indicator = $field->indicator(1);
1618             $ean = _normalize_match_point($field->subfield('a'));
1619             if ($indicator == 3 and $ean ne '') {
1620                 return $ean;
1621             }
1622         }
1623     }
1624 }
1625 sub GetNormalizedOCLCNumber {
1626     my ($record,$marcflavour) = @_;
1627     my (@fields,$oclc);
1628
1629     if ($marcflavour eq 'UNIMARC') {
1630         # TODO: add UNIMARC fields
1631     }
1632     else { # assume marc21 if not unimarc
1633         @fields = $record->field('035');
1634         foreach my $field (@fields) {
1635             $oclc = $field->subfield('a');
1636             if ($oclc =~ /OCoLC/) {
1637                 $oclc =~ s/\(OCoLC\)//;
1638                 return $oclc;
1639             } else {
1640                 return;
1641             }
1642         }
1643     }
1644 }
1645
1646 sub GetAuthvalueDropbox {
1647     my ( $authcat, $default ) = @_;
1648     my $branch_limit = C4::Context->userenv ? C4::Context->userenv->{"branch"} : "";
1649     my $dbh = C4::Context->dbh;
1650
1651     my $query = qq{
1652         SELECT *
1653         FROM authorised_values
1654     };
1655     $query .= qq{
1656           LEFT JOIN authorised_values_branches ON ( id = av_id )
1657     } if $branch_limit;
1658     $query .= qq{
1659         WHERE category = ?
1660     };
1661     $query .= " AND ( branchcode = ? OR branchcode IS NULL )" if $branch_limit;
1662     $query .= " GROUP BY lib ORDER BY category, lib, lib_opac";
1663     my $sth = $dbh->prepare($query);
1664     $sth->execute( $authcat, $branch_limit ? $branch_limit : () );
1665
1666
1667     my $option_list = [];
1668     my @authorised_values = ( q{} );
1669     while (my $av = $sth->fetchrow_hashref) {
1670         push @{$option_list}, {
1671             value => $av->{authorised_value},
1672             label => $av->{lib},
1673             default => ($default eq $av->{authorised_value}),
1674         };
1675     }
1676
1677     if ( @{$option_list} ) {
1678         return $option_list;
1679     }
1680     return;
1681 }
1682
1683
1684 =head2 GetDailyQuote($opts)
1685
1686 Takes a hashref of options
1687
1688 Currently supported options are:
1689
1690 'id'        An exact quote id
1691 'random'    Select a random quote
1692 noop        When no option is passed in, this sub will return the quote timestamped for the current day
1693
1694 The function returns an anonymous hash following this format:
1695
1696         {
1697           'source' => 'source-of-quote',
1698           'timestamp' => 'timestamp-value',
1699           'text' => 'text-of-quote',
1700           'id' => 'quote-id'
1701         };
1702
1703 =cut
1704
1705 # This is definitely a candidate for some sort of caching once we finally settle caching/persistence issues...
1706 # at least for default option
1707
1708 sub GetDailyQuote {
1709     my %opts = @_;
1710     my $dbh = C4::Context->dbh;
1711     my $query = '';
1712     my $sth = undef;
1713     my $quote = undef;
1714     if ($opts{'id'}) {
1715         $query = 'SELECT * FROM quotes WHERE id = ?';
1716         $sth = $dbh->prepare($query);
1717         $sth->execute($opts{'id'});
1718         $quote = $sth->fetchrow_hashref();
1719     }
1720     elsif ($opts{'random'}) {
1721         # Fall through... we also return a random quote as a catch-all if all else fails
1722     }
1723     else {
1724         $query = 'SELECT * FROM quotes WHERE timestamp LIKE CONCAT(CURRENT_DATE,\'%\') ORDER BY timestamp DESC LIMIT 0,1';
1725         $sth = $dbh->prepare($query);
1726         $sth->execute();
1727         $quote = $sth->fetchrow_hashref();
1728     }
1729     unless ($quote) {        # if there are not matches, choose a random quote
1730         # get a list of all available quote ids
1731         $sth = C4::Context->dbh->prepare('SELECT count(*) FROM quotes;');
1732         $sth->execute;
1733         my $range = ($sth->fetchrow_array)[0];
1734         # chose a random id within that range if there is more than one quote
1735         my $offset = int(rand($range));
1736         # grab it
1737         $query = 'SELECT * FROM quotes ORDER BY id LIMIT 1 OFFSET ?';
1738         $sth = C4::Context->dbh->prepare($query);
1739         # see http://www.perlmonks.org/?node_id=837422 for why
1740         # we're being verbose and using bind_param
1741         $sth->bind_param(1, $offset, SQL_INTEGER);
1742         $sth->execute();
1743         $quote = $sth->fetchrow_hashref();
1744         # update the timestamp for that quote
1745         $query = 'UPDATE quotes SET timestamp = ? WHERE id = ?';
1746         $sth = C4::Context->dbh->prepare($query);
1747         $sth->execute(
1748             DateTime::Format::MySQL->format_datetime( dt_from_string() ),
1749             $quote->{'id'}
1750         );
1751     }
1752     return $quote;
1753 }
1754
1755 sub _normalize_match_point {
1756     my $match_point = shift;
1757     (my $normalized_match_point) = $match_point =~ /([\d-]*[X]*)/;
1758     $normalized_match_point =~ s/-//g;
1759
1760     return $normalized_match_point;
1761 }
1762
1763 sub _isbn_cleanup {
1764     my ($isbn) = @_;
1765     return NormalizeISBN(
1766         {
1767             isbn          => $isbn,
1768             format        => 'ISBN-10',
1769             strip_hyphens => 1,
1770         }
1771     ) if $isbn;
1772 }
1773
1774 =head2 NormalizedISBN
1775
1776   my $isbns = NormalizedISBN({
1777     isbn => $isbn,
1778     strip_hyphens => [0,1],
1779     format => ['ISBN-10', 'ISBN-13']
1780   });
1781
1782   Returns an isbn validated by Business::ISBN.
1783   Optionally strips hyphens and/or forces the isbn
1784   to be of the specified format.
1785
1786   If the string cannot be validated as an isbn,
1787   it returns nothing.
1788
1789 =cut
1790
1791 sub NormalizeISBN {
1792     my ($params) = @_;
1793
1794     my $string        = $params->{isbn};
1795     my $strip_hyphens = $params->{strip_hyphens};
1796     my $format        = $params->{format};
1797
1798     return unless $string;
1799
1800     my $isbn = Business::ISBN->new($string);
1801
1802     if ( $isbn && $isbn->is_valid() ) {
1803
1804         if ( $format eq 'ISBN-10' ) {
1805             $isbn = $isbn->as_isbn10();
1806         }
1807         elsif ( $format eq 'ISBN-13' ) {
1808             $isbn = $isbn->as_isbn13();
1809         }
1810         return unless $isbn;
1811
1812         if ($strip_hyphens) {
1813             $string = $isbn->as_string( [] );
1814         } else {
1815             $string = $isbn->as_string();
1816         }
1817
1818         return $string;
1819     }
1820 }
1821
1822 =head2 GetVariationsOfISBN
1823
1824   my @isbns = GetVariationsOfISBN( $isbn );
1825
1826   Returns a list of variations of the given isbn in
1827   both ISBN-10 and ISBN-13 formats, with and without
1828   hyphens.
1829
1830   In a scalar context, the isbns are returned as a
1831   string delimited by ' | '.
1832
1833 =cut
1834
1835 sub GetVariationsOfISBN {
1836     my ($isbn) = @_;
1837
1838     return unless $isbn;
1839
1840     my @isbns;
1841
1842     push( @isbns, NormalizeISBN({ isbn => $isbn }) );
1843     push( @isbns, NormalizeISBN({ isbn => $isbn, format => 'ISBN-10' }) );
1844     push( @isbns, NormalizeISBN({ isbn => $isbn, format => 'ISBN-13' }) );
1845     push( @isbns, NormalizeISBN({ isbn => $isbn, format => 'ISBN-10', strip_hyphens => 1 }) );
1846     push( @isbns, NormalizeISBN({ isbn => $isbn, format => 'ISBN-13', strip_hyphens => 1 }) );
1847
1848     # Strip out any "empty" strings from the array
1849     @isbns = grep { defined($_) && $_ =~ /\S/ } @isbns;
1850
1851     return wantarray ? @isbns : join( " | ", @isbns );
1852 }
1853
1854 =head2 GetVariationsOfISBNs
1855
1856   my @isbns = GetVariationsOfISBNs( @isbns );
1857
1858   Returns a list of variations of the given isbns in
1859   both ISBN-10 and ISBN-13 formats, with and without
1860   hyphens.
1861
1862   In a scalar context, the isbns are returned as a
1863   string delimited by ' | '.
1864
1865 =cut
1866
1867 sub GetVariationsOfISBNs {
1868     my (@isbns) = @_;
1869
1870     @isbns = map { GetVariationsOfISBN( $_ ) } @isbns;
1871
1872     return wantarray ? @isbns : join( " | ", @isbns );
1873 }
1874
1875 =head2 IsKohaFieldLinked
1876
1877     my $is_linked = IsKohaFieldLinked({
1878         kohafield => $kohafield,
1879         frameworkcode => $frameworkcode,
1880     });
1881
1882     Return 1 if the field is linked
1883
1884 =cut
1885
1886 sub IsKohaFieldLinked {
1887     my ( $params ) = @_;
1888     my $kohafield = $params->{kohafield};
1889     my $frameworkcode = $params->{frameworkcode} || '';
1890     my $dbh = C4::Context->dbh;
1891     my $is_linked = $dbh->selectcol_arrayref( q|
1892         SELECT COUNT(*)
1893         FROM marc_subfield_structure
1894         WHERE frameworkcode = ?
1895         AND kohafield = ?
1896     |,{}, $frameworkcode, $kohafield );
1897     return $is_linked->[0];
1898 }
1899
1900 1;
1901
1902 __END__
1903
1904 =head1 AUTHOR
1905
1906 Koha Team
1907
1908 =cut