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