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