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