C4/Koha.pm

   1 package C4::Koha;
   2
   3 # Copyright 2000-2002 Katipo Communications
   4 # Parts Copyright 2010 Nelsonville Public Library
   5 # Parts copyright 2010 BibLibre
   6 #
   7 # This file is part of Koha.
   8 #
   9 # Koha is free software; you can redistribute it and/or modify it
  10 # under the terms of the GNU General Public License as published by
  11 # the Free Software Foundation; either version 3 of the License, or
  12 # (at your option) any later version.
  13 #
  14 # Koha is distributed in the hope that it will be useful, but
  15 # WITHOUT ANY WARRANTY; without even the implied warranty of
  16 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  17 # GNU General Public License for more details.
  18 #
  19 # You should have received a copy of the GNU General Public License
  20 # along with Koha; if not, see <http://www.gnu.org/licenses>.
  21
  22
  23 use strict;
  24 #use warnings; FIXME - Bug 2505
  25
  26 use C4::Context;
  27 use C4::Branch; # Can be removed?
  28 use Koha::Cache;
  29 use Koha::DateUtils qw(dt_from_string);
  30 use Koha::Libraries;
  31 use DateTime::Format::MySQL;
  32 use Business::ISBN;
  33 use autouse 'Data::cselectall_arrayref' => qw(Dumper);
  34 use DBI qw(:sql_types);
  35 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK $DEBUG);
  36
  37 BEGIN {
  38     $VERSION = 3.07.00.049;
  39         require Exporter;
  40         @ISA    = qw(Exporter);
  41         @EXPORT = qw(
  42                 &slashifyDate
  43                 &subfield_is_koha_internal_p
  44                 &GetPrinters &GetPrinter
  45                 &GetItemTypes &getitemtypeinfo
  46                 &GetItemTypesCategorized &GetItemTypesByCategory
  47                 &GetSupportName &GetSupportList
  48                 &get_itemtypeinfos_of
  49                 &getframeworks &getframeworkinfo
  50         &GetFrameworksLoop
  51                 &getallthemes
  52                 &getFacets
  53                 &displayServers
  54                 &getnbpages
  55                 &get_infos_of
  56                 &get_notforloan_label_of
  57                 &getitemtypeimagedir
  58                 &getitemtypeimagesrc
  59                 &getitemtypeimagelocation
  60                 &GetAuthorisedValues
  61                 &GetAuthorisedValueCategories
  62                 &IsAuthorisedValueCategory
  63                 &GetKohaAuthorisedValues
  64                 &GetKohaAuthorisedValuesFromField
  65     &GetKohaAuthorisedValuesMapping
  66     &GetKohaAuthorisedValueLib
  67     &GetAuthorisedValueByCode
  68                 &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 $dbh   = C4::Context->dbh;
 253     my $query = q|
 254         SELECT
 255                itemtypes.itemtype,
 256                itemtypes.description,
 257                itemtypes.rentalcharge,
 258                itemtypes.notforloan,
 259                itemtypes.imageurl,
 260                itemtypes.summary,
 261                itemtypes.checkinmsg,
 262                itemtypes.checkinmsgtype,
 263                itemtypes.sip_media_type,
 264                itemtypes.hideinopac,
 265                itemtypes.searchcategory,
 266                COALESCE( localization.translation, itemtypes.description ) AS translated_description
 267         FROM   itemtypes
 268         LEFT JOIN localization ON itemtypes.itemtype = localization.code
 269             AND localization.entity = 'itemtypes'
 270             AND localization.lang = ?
 271         ORDER BY itemtype
 272     |;
 273     my $sth = $dbh->prepare($query);
 274     $sth->execute( $language );
 275
 276     if ( $style eq 'hash' ) {
 277         my %itemtypes;
 278         while ( my $IT = $sth->fetchrow_hashref ) {
 279             $itemtypes{ $IT->{'itemtype'} } = $IT;
 280         }
 281         return ( \%itemtypes );
 282     } else {
 283         return [ sort { lc $a->{translated_description} cmp lc $b->{translated_description} } @{ $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                 || Koha::Libraries->search->count == 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                 || Koha::Libraries->search->count == 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 =head2 GetAuthValCode
1080
1081   $authvalcode = GetAuthValCode($kohafield,$frameworkcode);
1082
1083 =cut
1084
1085 sub GetAuthValCode {
1086         my ($kohafield,$fwcode) = @_;
1087         my $dbh = C4::Context->dbh;
1088         $fwcode='' unless $fwcode;
1089         my $sth = $dbh->prepare('select authorised_value from marc_subfield_structure where kohafield=? and frameworkcode=?');
1090         $sth->execute($kohafield,$fwcode);
1091         my ($authvalcode) = $sth->fetchrow_array;
1092         return $authvalcode;
1093 }
1094
1095 =head2 GetAuthValCodeFromField
1096
1097   $authvalcode = GetAuthValCodeFromField($field,$subfield,$frameworkcode);
1098
1099 C<$subfield> can be undefined
1100
1101 =cut
1102
1103 sub GetAuthValCodeFromField {
1104         my ($field,$subfield,$fwcode) = @_;
1105         my $dbh = C4::Context->dbh;
1106         $fwcode='' unless $fwcode;
1107         my $sth;
1108         if (defined $subfield) {
1109             $sth = $dbh->prepare('select authorised_value from marc_subfield_structure where tagfield=? and tagsubfield=? and frameworkcode=?');
1110             $sth->execute($field,$subfield,$fwcode);
1111         } else {
1112             $sth = $dbh->prepare('select authorised_value from marc_tag_structure where tagfield=? and frameworkcode=?');
1113             $sth->execute($field,$fwcode);
1114         }
1115         my ($authvalcode) = $sth->fetchrow_array;
1116         return $authvalcode;
1117 }
1118
1119 =head2 GetAuthorisedValues
1120
1121   $authvalues = GetAuthorisedValues([$category], [$selected]);
1122
1123 This function returns all authorised values from the'authorised_value' table in a reference to array of hashrefs.
1124
1125 C<$category> returns authorised values for just one category (optional).
1126
1127 C<$selected> adds a "selected => 1" entry to the hash if the
1128 authorised_value matches it. B<NOTE:> this feature should be considered
1129 deprecated as it may be removed in the future.
1130
1131 C<$opac> If set to a true value, displays OPAC descriptions rather than normal ones when they exist.
1132
1133 =cut
1134
1135 sub GetAuthorisedValues {
1136     my ( $category, $selected, $opac ) = @_;
1137
1138     # TODO: the "selected" feature should be replaced by a utility function
1139     # somewhere else, it doesn't belong in here. For starters it makes
1140     # caching much more complicated. Or just let the UI logic handle it, it's
1141     # what it's for.
1142
1143     # Is this cached already?
1144     $opac = $opac ? 1 : 0;    # normalise to be safe
1145     my $branch_limit =
1146       C4::Context->userenv ? C4::Context->userenv->{"branch"} : "";
1147     my $selected_key = defined($selected) ? $selected : '';
1148     my $cache_key =
1149       "AuthorisedValues-$category-$selected_key-$opac-$branch_limit";
1150     my $cache  = Koha::Cache->get_instance();
1151     my $result = $cache->get_from_cache($cache_key);
1152     return $result if $result;
1153
1154     my @results;
1155     my $dbh      = C4::Context->dbh;
1156     my $query = qq{
1157         SELECT *
1158         FROM authorised_values
1159     };
1160     $query .= qq{
1161           LEFT JOIN authorised_values_branches ON ( id = av_id )
1162     } if $branch_limit;
1163     my @where_strings;
1164     my @where_args;
1165     if($category) {
1166         push @where_strings, "category = ?";
1167         push @where_args, $category;
1168     }
1169     if($branch_limit) {
1170         push @where_strings, "( branchcode = ? OR branchcode IS NULL )";
1171         push @where_args, $branch_limit;
1172     }
1173     if(@where_strings > 0) {
1174         $query .= " WHERE " . join(" AND ", @where_strings);
1175     }
1176     $query .= " GROUP BY lib";
1177     $query .= ' ORDER BY category, ' . (
1178                 $opac ? 'COALESCE(lib_opac, lib)'
1179                       : 'lib, lib_opac'
1180               );
1181
1182     my $sth = $dbh->prepare($query);
1183
1184     $sth->execute( @where_args );
1185     while (my $data=$sth->fetchrow_hashref) {
1186         if ( defined $selected and $selected eq $data->{authorised_value} ) {
1187             $data->{selected} = 1;
1188         }
1189         else {
1190             $data->{selected} = 0;
1191         }
1192
1193         if ($opac && $data->{lib_opac}) {
1194             $data->{lib} = $data->{lib_opac};
1195         }
1196         push @results, $data;
1197     }
1198     $sth->finish;
1199
1200     # We can't cache for long because of that "selected" thing which
1201     # makes it impossible to clear the cache without iterating through every
1202     # value, which sucks. This'll cover this request, and not a whole lot more.
1203     $cache->set_in_cache( $cache_key, \@results, { deepcopy => 1, expiry => 5 } );
1204     return \@results;
1205 }
1206
1207 =head2 GetAuthorisedValueCategories
1208
1209   $auth_categories = GetAuthorisedValueCategories();
1210
1211 Return an arrayref of all of the available authorised
1212 value categories.
1213
1214 =cut
1215
1216 sub GetAuthorisedValueCategories {
1217     my $dbh = C4::Context->dbh;
1218     my $sth = $dbh->prepare("SELECT DISTINCT category FROM authorised_values ORDER BY category");
1219     $sth->execute;
1220     my @results;
1221     while (defined (my $category  = $sth->fetchrow_array) ) {
1222         push @results, $category;
1223     }
1224     return \@results;
1225 }
1226
1227 =head2 IsAuthorisedValueCategory
1228
1229     $is_auth_val_category = IsAuthorisedValueCategory($category);
1230
1231 Returns whether a given category name is a valid one
1232
1233 =cut
1234
1235 sub IsAuthorisedValueCategory {
1236     my $category = shift;
1237     my $query = '
1238         SELECT category
1239         FROM authorised_values
1240         WHERE category=?
1241         LIMIT 1
1242     ';
1243     my $sth = C4::Context->dbh->prepare($query);
1244     $sth->execute($category);
1245     $sth->fetchrow ? return 1
1246                    : return 0;
1247 }
1248
1249 =head2 GetAuthorisedValueByCode
1250
1251 $authorised_value = GetAuthorisedValueByCode( $category, $authvalcode, $opac );
1252
1253 Return the lib attribute from authorised_values from the row identified
1254 by the passed category and code
1255
1256 =cut
1257
1258 sub GetAuthorisedValueByCode {
1259     my ( $category, $authvalcode, $opac ) = @_;
1260
1261     my $field = $opac ? 'lib_opac' : 'lib';
1262     my $dbh = C4::Context->dbh;
1263     my $sth = $dbh->prepare("SELECT $field FROM authorised_values WHERE category=? AND authorised_value =?");
1264     $sth->execute( $category, $authvalcode );
1265     while ( my $data = $sth->fetchrow_hashref ) {
1266         return $data->{ $field };
1267     }
1268 }
1269
1270 =head2 GetKohaAuthorisedValues
1271
1272 Takes $kohafield, $fwcode as parameters.
1273
1274 If $opac parameter is set to a true value, displays OPAC descriptions rather than normal ones when they exist.
1275
1276 Returns hashref of Code => description
1277
1278 Returns undef if no authorised value category is defined for the kohafield.
1279
1280 =cut
1281
1282 sub GetKohaAuthorisedValues {
1283   my ($kohafield,$fwcode,$opac) = @_;
1284   $fwcode='' unless $fwcode;
1285   my %values;
1286   my $dbh = C4::Context->dbh;
1287   my $avcode = GetAuthValCode($kohafield,$fwcode);
1288   if ($avcode) {
1289         my $sth = $dbh->prepare("select authorised_value, lib, lib_opac from authorised_values where category=? ");
1290         $sth->execute($avcode);
1291         while ( my ($val, $lib, $lib_opac) = $sth->fetchrow_array ) {
1292                 $values{$val} = ($opac && $lib_opac) ? $lib_opac : $lib;
1293         }
1294         return \%values;
1295   } else {
1296         return;
1297   }
1298 }
1299
1300 =head2 GetKohaAuthorisedValuesFromField
1301
1302 Takes $field, $subfield, $fwcode as parameters.
1303
1304 If $opac parameter is set to a true value, displays OPAC descriptions rather than normal ones when they exist.
1305 $subfield can be undefined
1306
1307 Returns hashref of Code => description
1308
1309 Returns undef if no authorised value category is defined for the given field and subfield
1310
1311 =cut
1312
1313 sub GetKohaAuthorisedValuesFromField {
1314   my ($field, $subfield, $fwcode,$opac) = @_;
1315   $fwcode='' unless $fwcode;
1316   my %values;
1317   my $dbh = C4::Context->dbh;
1318   my $avcode = GetAuthValCodeFromField($field, $subfield, $fwcode);
1319   if ($avcode) {
1320         my $sth = $dbh->prepare("select authorised_value, lib, lib_opac from authorised_values where category=? ");
1321         $sth->execute($avcode);
1322         while ( my ($val, $lib, $lib_opac) = $sth->fetchrow_array ) {
1323                 $values{$val} = ($opac && $lib_opac) ? $lib_opac : $lib;
1324         }
1325         return \%values;
1326   } else {
1327         return;
1328   }
1329 }
1330
1331 =head2 GetKohaAuthorisedValuesMapping
1332
1333 Takes a hash as a parameter. The interface key indicates the
1334 description to use in the mapping.
1335
1336 Returns hashref of:
1337  "{kohafield},{frameworkcode},{authorised_value}" => "{description}"
1338 for all the kohafields, frameworkcodes, and authorised values.
1339
1340 Returns undef if nothing is found.
1341
1342 =cut
1343
1344 sub GetKohaAuthorisedValuesMapping {
1345     my ($parameter) = @_;
1346     my $interface = $parameter->{'interface'} // '';
1347
1348     my $query_mapping = q{
1349 SELECT TA.kohafield,TA.authorised_value AS category,
1350        TA.frameworkcode,TB.authorised_value,
1351        IF(TB.lib_opac>'',TB.lib_opac,TB.lib) AS OPAC,
1352        TB.lib AS Intranet,TB.lib_opac
1353 FROM marc_subfield_structure AS TA JOIN
1354      authorised_values as TB ON
1355      TA.authorised_value=TB.category
1356 WHERE TA.kohafield>'' AND TA.authorised_value>'';
1357     };
1358     my $dbh = C4::Context->dbh;
1359     my $sth = $dbh->prepare($query_mapping);
1360     $sth->execute();
1361     my $avmapping;
1362     if ($interface eq 'opac') {
1363         while (my $row = $sth->fetchrow_hashref) {
1364             $avmapping->{$row->{kohafield}.",".$row->{frameworkcode}.",".$row->{authorised_value}} = $row->{OPAC};
1365         }
1366     }
1367     else {
1368         while (my $row = $sth->fetchrow_hashref) {
1369             $avmapping->{$row->{kohafield}.",".$row->{frameworkcode}.",".$row->{authorised_value}} = $row->{Intranet};
1370         }
1371     }
1372     return $avmapping;
1373 }
1374
1375 =head2 xml_escape
1376
1377   my $escaped_string = C4::Koha::xml_escape($string);
1378
1379 Convert &, <, >, ', and " in a string to XML entities
1380
1381 =cut
1382
1383 sub xml_escape {
1384     my $str = shift;
1385     return '' unless defined $str;
1386     $str =~ s/&/&amp;/g;
1387     $str =~ s/</&lt;/g;
1388     $str =~ s/>/&gt;/g;
1389     $str =~ s/'/&apos;/g;
1390     $str =~ s/"/&quot;/g;
1391     return $str;
1392 }
1393
1394 =head2 GetKohaAuthorisedValueLib
1395
1396 Takes $category, $authorised_value as parameters.
1397
1398 If $opac parameter is set to a true value, displays OPAC descriptions rather than normal ones when they exist.
1399
1400 Returns authorised value description
1401
1402 =cut
1403
1404 sub GetKohaAuthorisedValueLib {
1405   my ($category,$authorised_value,$opac) = @_;
1406   my $value;
1407   my $dbh = C4::Context->dbh;
1408   my $sth = $dbh->prepare("select lib, lib_opac from authorised_values where category=? and authorised_value=?");
1409   $sth->execute($category,$authorised_value);
1410   my $data = $sth->fetchrow_hashref;
1411   $value = ($opac && $$data{'lib_opac'}) ? $$data{'lib_opac'} : $$data{'lib'};
1412   return $value;
1413 }
1414
1415 =head2 AddAuthorisedValue
1416
1417     AddAuthorisedValue($category, $authorised_value, $lib, $lib_opac, $imageurl);
1418
1419 Create a new authorised value.
1420
1421 =cut
1422
1423 sub AddAuthorisedValue {
1424     my ($category, $authorised_value, $lib, $lib_opac, $imageurl) = @_;
1425
1426     my $dbh = C4::Context->dbh;
1427     my $query = qq{
1428         INSERT INTO authorised_values (category, authorised_value, lib, lib_opac, imageurl)
1429         VALUES (?,?,?,?,?)
1430     };
1431     my $sth = $dbh->prepare($query);
1432     $sth->execute($category, $authorised_value, $lib, $lib_opac, $imageurl);
1433 }
1434
1435 =head2 display_marc_indicators
1436
1437   my $display_form = C4::Koha::display_marc_indicators($field);
1438
1439 C<$field> is a MARC::Field object
1440
1441 Generate a display form of the indicators of a variable
1442 MARC field, replacing any blanks with '#'.
1443
1444 =cut
1445
1446 sub display_marc_indicators {
1447     my $field = shift;
1448     my $indicators = '';
1449     if ($field && $field->tag() >= 10) {
1450         $indicators = $field->indicator(1) . $field->indicator(2);
1451         $indicators =~ s/ /#/g;
1452     }
1453     return $indicators;
1454 }
1455
1456 sub GetNormalizedUPC {
1457     my ($marcrecord,$marcflavour) = @_;
1458
1459     return unless $marcrecord;
1460     if ($marcflavour eq 'UNIMARC') {
1461         my @fields = $marcrecord->field('072');
1462         foreach my $field (@fields) {
1463             my $upc = _normalize_match_point($field->subfield('a'));
1464             if ($upc) {
1465                 return $upc;
1466             }
1467         }
1468
1469     }
1470     else { # assume marc21 if not unimarc
1471         my @fields = $marcrecord->field('024');
1472         foreach my $field (@fields) {
1473             my $indicator = $field->indicator(1);
1474             my $upc = _normalize_match_point($field->subfield('a'));
1475             if ($upc && $indicator == 1 ) {
1476                 return $upc;
1477             }
1478         }
1479     }
1480 }
1481
1482 # Normalizes and returns the first valid ISBN found in the record
1483 # ISBN13 are converted into ISBN10. This is required to get some book cover images.
1484 sub GetNormalizedISBN {
1485     my ($isbn,$marcrecord,$marcflavour) = @_;
1486     if ($isbn) {
1487         # Koha attempts to store multiple ISBNs in biblioitems.isbn, separated by " | "
1488         # anything after " | " should be removed, along with the delimiter
1489         ($isbn) = split(/\|/, $isbn );
1490         return _isbn_cleanup($isbn);
1491     }
1492
1493     return unless $marcrecord;
1494
1495     if ($marcflavour eq 'UNIMARC') {
1496         my @fields = $marcrecord->field('010');
1497         foreach my $field (@fields) {
1498             my $isbn = $field->subfield('a');
1499             if ($isbn) {
1500                 return _isbn_cleanup($isbn);
1501             }
1502         }
1503     }
1504     else { # assume marc21 if not unimarc
1505         my @fields = $marcrecord->field('020');
1506         foreach my $field (@fields) {
1507             $isbn = $field->subfield('a');
1508             if ($isbn) {
1509                 return _isbn_cleanup($isbn);
1510             }
1511         }
1512     }
1513 }
1514
1515 sub GetNormalizedEAN {
1516     my ($marcrecord,$marcflavour) = @_;
1517
1518     return unless $marcrecord;
1519
1520     if ($marcflavour eq 'UNIMARC') {
1521         my @fields = $marcrecord->field('073');
1522         foreach my $field (@fields) {
1523             my $ean = _normalize_match_point($field->subfield('a'));
1524             if ( $ean ) {
1525                 return $ean;
1526             }
1527         }
1528     }
1529     else { # assume marc21 if not unimarc
1530         my @fields = $marcrecord->field('024');
1531         foreach my $field (@fields) {
1532             my $indicator = $field->indicator(1);
1533             my $ean = _normalize_match_point($field->subfield('a'));
1534             if ( $ean && $indicator == 3  ) {
1535                 return $ean;
1536             }
1537         }
1538     }
1539 }
1540
1541 sub GetNormalizedOCLCNumber {
1542     my ($marcrecord,$marcflavour) = @_;
1543     return unless $marcrecord;
1544
1545     if ($marcflavour ne 'UNIMARC' ) {
1546         my @fields = $marcrecord->field('035');
1547         foreach my $field (@fields) {
1548             my $oclc = $field->subfield('a');
1549             if ($oclc =~ /OCoLC/) {
1550                 $oclc =~ s/\(OCoLC\)//;
1551                 return $oclc;
1552             }
1553         }
1554     } else {
1555         # TODO for UNIMARC
1556     }
1557     return
1558 }
1559
1560 sub GetAuthvalueDropbox {
1561     my ( $authcat, $default ) = @_;
1562     my $branch_limit = C4::Context->userenv ? C4::Context->userenv->{"branch"} : "";
1563     my $dbh = C4::Context->dbh;
1564
1565     my $query = qq{
1566         SELECT *
1567         FROM authorised_values
1568     };
1569     $query .= qq{
1570           LEFT JOIN authorised_values_branches ON ( id = av_id )
1571     } if $branch_limit;
1572     $query .= qq{
1573         WHERE category = ?
1574     };
1575     $query .= " AND ( branchcode = ? OR branchcode IS NULL )" if $branch_limit;
1576     $query .= " GROUP BY lib ORDER BY category, lib, lib_opac";
1577     my $sth = $dbh->prepare($query);
1578     $sth->execute( $authcat, $branch_limit ? $branch_limit : () );
1579
1580
1581     my $option_list = [];
1582     my @authorised_values = ( q{} );
1583     while (my $av = $sth->fetchrow_hashref) {
1584         push @{$option_list}, {
1585             value => $av->{authorised_value},
1586             label => $av->{lib},
1587             default => ($default eq $av->{authorised_value}),
1588         };
1589     }
1590
1591     if ( @{$option_list} ) {
1592         return $option_list;
1593     }
1594     return;
1595 }
1596
1597
1598 =head2 GetDailyQuote($opts)
1599
1600 Takes a hashref of options
1601
1602 Currently supported options are:
1603
1604 'id'        An exact quote id
1605 'random'    Select a random quote
1606 noop        When no option is passed in, this sub will return the quote timestamped for the current day
1607
1608 The function returns an anonymous hash following this format:
1609
1610         {
1611           'source' => 'source-of-quote',
1612           'timestamp' => 'timestamp-value',
1613           'text' => 'text-of-quote',
1614           'id' => 'quote-id'
1615         };
1616
1617 =cut
1618
1619 # This is definitely a candidate for some sort of caching once we finally settle caching/persistence issues...
1620 # at least for default option
1621
1622 sub GetDailyQuote {
1623     my %opts = @_;
1624     my $dbh = C4::Context->dbh;
1625     my $query = '';
1626     my $sth = undef;
1627     my $quote = undef;
1628     if ($opts{'id'}) {
1629         $query = 'SELECT * FROM quotes WHERE id = ?';
1630         $sth = $dbh->prepare($query);
1631         $sth->execute($opts{'id'});
1632         $quote = $sth->fetchrow_hashref();
1633     }
1634     elsif ($opts{'random'}) {
1635         # Fall through... we also return a random quote as a catch-all if all else fails
1636     }
1637     else {
1638         $query = 'SELECT * FROM quotes WHERE timestamp LIKE CONCAT(CURRENT_DATE,\'%\') ORDER BY timestamp DESC LIMIT 0,1';
1639         $sth = $dbh->prepare($query);
1640         $sth->execute();
1641         $quote = $sth->fetchrow_hashref();
1642     }
1643     unless ($quote) {        # if there are not matches, choose a random quote
1644         # get a list of all available quote ids
1645         $sth = C4::Context->dbh->prepare('SELECT count(*) FROM quotes;');
1646         $sth->execute;
1647         my $range = ($sth->fetchrow_array)[0];
1648         # chose a random id within that range if there is more than one quote
1649         my $offset = int(rand($range));
1650         # grab it
1651         $query = 'SELECT * FROM quotes ORDER BY id LIMIT 1 OFFSET ?';
1652         $sth = C4::Context->dbh->prepare($query);
1653         # see http://www.perlmonks.org/?node_id=837422 for why
1654         # we're being verbose and using bind_param
1655         $sth->bind_param(1, $offset, SQL_INTEGER);
1656         $sth->execute();
1657         $quote = $sth->fetchrow_hashref();
1658         # update the timestamp for that quote
1659         $query = 'UPDATE quotes SET timestamp = ? WHERE id = ?';
1660         $sth = C4::Context->dbh->prepare($query);
1661         $sth->execute(
1662             DateTime::Format::MySQL->format_datetime( dt_from_string() ),
1663             $quote->{'id'}
1664         );
1665     }
1666     return $quote;
1667 }
1668
1669 sub _normalize_match_point {
1670     my $match_point = shift;
1671     (my $normalized_match_point) = $match_point =~ /([\d-]*[X]*)/;
1672     $normalized_match_point =~ s/-//g;
1673
1674     return $normalized_match_point;
1675 }
1676
1677 sub _isbn_cleanup {
1678     my ($isbn) = @_;
1679     return NormalizeISBN(
1680         {
1681             isbn          => $isbn,
1682             format        => 'ISBN-10',
1683             strip_hyphens => 1,
1684         }
1685     ) if $isbn;
1686 }
1687
1688 =head2 NormalizedISBN
1689
1690   my $isbns = NormalizedISBN({
1691     isbn => $isbn,
1692     strip_hyphens => [0,1],
1693     format => ['ISBN-10', 'ISBN-13']
1694   });
1695
1696   Returns an isbn validated by Business::ISBN.
1697   Optionally strips hyphens and/or forces the isbn
1698   to be of the specified format.
1699
1700   If the string cannot be validated as an isbn,
1701   it returns nothing.
1702
1703 =cut
1704
1705 sub NormalizeISBN {
1706     my ($params) = @_;
1707
1708     my $string        = $params->{isbn};
1709     my $strip_hyphens = $params->{strip_hyphens};
1710     my $format        = $params->{format};
1711
1712     return unless $string;
1713
1714     my $isbn = Business::ISBN->new($string);
1715
1716     if ( $isbn && $isbn->is_valid() ) {
1717
1718         if ( $format eq 'ISBN-10' ) {
1719             $isbn = $isbn->as_isbn10();
1720         }
1721         elsif ( $format eq 'ISBN-13' ) {
1722             $isbn = $isbn->as_isbn13();
1723         }
1724         return unless $isbn;
1725
1726         if ($strip_hyphens) {
1727             $string = $isbn->as_string( [] );
1728         } else {
1729             $string = $isbn->as_string();
1730         }
1731
1732         return $string;
1733     }
1734 }
1735
1736 =head2 GetVariationsOfISBN
1737
1738   my @isbns = GetVariationsOfISBN( $isbn );
1739
1740   Returns a list of variations of the given isbn in
1741   both ISBN-10 and ISBN-13 formats, with and without
1742   hyphens.
1743
1744   In a scalar context, the isbns are returned as a
1745   string delimited by ' | '.
1746
1747 =cut
1748
1749 sub GetVariationsOfISBN {
1750     my ($isbn) = @_;
1751
1752     return unless $isbn;
1753
1754     my @isbns;
1755
1756     push( @isbns, NormalizeISBN({ isbn => $isbn }) );
1757     push( @isbns, NormalizeISBN({ isbn => $isbn, format => 'ISBN-10' }) );
1758     push( @isbns, NormalizeISBN({ isbn => $isbn, format => 'ISBN-13' }) );
1759     push( @isbns, NormalizeISBN({ isbn => $isbn, format => 'ISBN-10', strip_hyphens => 1 }) );
1760     push( @isbns, NormalizeISBN({ isbn => $isbn, format => 'ISBN-13', strip_hyphens => 1 }) );
1761
1762     # Strip out any "empty" strings from the array
1763     @isbns = grep { defined($_) && $_ =~ /\S/ } @isbns;
1764
1765     return wantarray ? @isbns : join( " | ", @isbns );
1766 }
1767
1768 =head2 GetVariationsOfISBNs
1769
1770   my @isbns = GetVariationsOfISBNs( @isbns );
1771
1772   Returns a list of variations of the given isbns in
1773   both ISBN-10 and ISBN-13 formats, with and without
1774   hyphens.
1775
1776   In a scalar context, the isbns are returned as a
1777   string delimited by ' | '.
1778
1779 =cut
1780
1781 sub GetVariationsOfISBNs {
1782     my (@isbns) = @_;
1783
1784     @isbns = map { GetVariationsOfISBN( $_ ) } @isbns;
1785
1786     return wantarray ? @isbns : join( " | ", @isbns );
1787 }
1788
1789 =head2 IsKohaFieldLinked
1790
1791     my $is_linked = IsKohaFieldLinked({
1792         kohafield => $kohafield,
1793         frameworkcode => $frameworkcode,
1794     });
1795
1796     Return 1 if the field is linked
1797
1798 =cut
1799
1800 sub IsKohaFieldLinked {
1801     my ( $params ) = @_;
1802     my $kohafield = $params->{kohafield};
1803     my $frameworkcode = $params->{frameworkcode} || '';
1804     my $dbh = C4::Context->dbh;
1805     my $is_linked = $dbh->selectcol_arrayref( q|
1806         SELECT COUNT(*)
1807         FROM marc_subfield_structure
1808         WHERE frameworkcode = ?
1809         AND kohafield = ?
1810     |,{}, $frameworkcode, $kohafield );
1811     return $is_linked->[0];
1812 }
1813
1814 1;
1815
1816 __END__
1817
1818 =head1 AUTHOR
1819
1820 Koha Team
1821
1822 =cut