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