C4/Koha.pm

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