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 Koha::Caches;
  28 use Koha::DateUtils qw(dt_from_string);
  29 use Koha::AuthorisedValues;
  30 use Koha::Libraries;
  31 use Koha::MarcSubfieldStructures;
  32 use DateTime::Format::MySQL;
  33 use Business::ISBN;
  34 use autouse 'Data::cselectall_arrayref' => qw(Dumper);
  35 use DBI qw(:sql_types);
  36 use vars qw(@ISA @EXPORT @EXPORT_OK $DEBUG);
  37
  38 BEGIN {
  39         require Exporter;
  40         @ISA    = qw(Exporter);
  41         @EXPORT = qw(
  42                 &GetPrinters &GetPrinter
  43                 &GetItemTypes &getitemtypeinfo
  44                 &GetItemTypesCategorized &GetItemTypesByCategory
  45                 &getframeworks &getframeworkinfo
  46         &GetFrameworksLoop
  47                 &getallthemes
  48                 &getFacets
  49                 &getnbpages
  50                 &get_infos_of
  51                 &get_notforloan_label_of
  52                 &getitemtypeimagedir
  53                 &getitemtypeimagesrc
  54                 &getitemtypeimagelocation
  55                 &GetAuthorisedValues
  56                 &GetAuthorisedValueCategories
  57                 &GetKohaAuthorisedValues
  58                 &GetNormalizedUPC
  59                 &GetNormalizedISBN
  60                 &GetNormalizedEAN
  61                 &GetNormalizedOCLCNumber
  62         &xml_escape
  63
  64         &GetVariationsOfISBN
  65         &GetVariationsOfISBNs
  66         &NormalizeISBN
  67
  68                 $DEBUG
  69         );
  70         $DEBUG = 0;
  71 @EXPORT_OK = qw( GetDailyQuote );
  72 }
  73
  74 =head1 NAME
  75
  76 C4::Koha - Perl Module containing convenience functions for Koha scripts
  77
  78 =head1 SYNOPSIS
  79
  80 use C4::Koha;
  81
  82 =head1 DESCRIPTION
  83
  84 Koha.pm provides many functions for Koha scripts.
  85
  86 =head1 FUNCTIONS
  87
  88 =cut
  89
  90 =head2 GetItemTypes
  91
  92   $itemtypes = &GetItemTypes( style => $style );
  93
  94 Returns information about existing itemtypes.
  95
  96 Params:
  97     style: either 'array' or 'hash', defaults to 'hash'.
  98            'array' returns an arrayref,
  99            'hash' return a hashref with the itemtype value as the key
 100
 101 build a HTML select with the following code :
 102
 103 =head3 in PERL SCRIPT
 104
 105     my $itemtypes = GetItemTypes;
 106     my @itemtypesloop;
 107     foreach my $thisitemtype (sort keys %$itemtypes) {
 108         my $selected = 1 if $thisitemtype eq $itemtype;
 109         my %row =(value => $thisitemtype,
 110                     selected => $selected,
 111                     description => $itemtypes->{$thisitemtype}->{'description'},
 112                 );
 113         push @itemtypesloop, \%row;
 114     }
 115     $template->param(itemtypeloop => \@itemtypesloop);
 116
 117 =head3 in TEMPLATE
 118
 119     <form action='<!-- TMPL_VAR name="script_name" -->' method=post>
 120         <select name="itemtype">
 121             <option value="">Default</option>
 122         <!-- TMPL_LOOP name="itemtypeloop" -->
 123             <option value="<!-- TMPL_VAR name="value" -->" <!-- TMPL_IF name="selected" -->selected<!-- /TMPL_IF -->><!-- TMPL_VAR name="description" --></option>
 124         <!-- /TMPL_LOOP -->
 125         </select>
 126         <input type=text name=searchfield value="<!-- TMPL_VAR name="searchfield" -->">
 127         <input type="submit" value="OK" class="button">
 128     </form>
 129
 130 =cut
 131
 132 sub GetItemTypes {
 133     my ( %params ) = @_;
 134     my $style = defined( $params{'style'} ) ? $params{'style'} : 'hash';
 135
 136     require C4::Languages;
 137     my $language = C4::Languages::getlanguage();
 138     # returns a reference to a hash of references to itemtypes...
 139     my $dbh   = C4::Context->dbh;
 140     my $query = q|
 141         SELECT
 142                itemtypes.itemtype,
 143                itemtypes.description,
 144                itemtypes.rentalcharge,
 145                itemtypes.notforloan,
 146                itemtypes.imageurl,
 147                itemtypes.summary,
 148                itemtypes.checkinmsg,
 149                itemtypes.checkinmsgtype,
 150                itemtypes.sip_media_type,
 151                itemtypes.hideinopac,
 152                itemtypes.searchcategory,
 153                COALESCE( localization.translation, itemtypes.description ) AS translated_description
 154         FROM   itemtypes
 155         LEFT JOIN localization ON itemtypes.itemtype = localization.code
 156             AND localization.entity = 'itemtypes'
 157             AND localization.lang = ?
 158         ORDER BY itemtype
 159     |;
 160     my $sth = $dbh->prepare($query);
 161     $sth->execute( $language );
 162
 163     if ( $style eq 'hash' ) {
 164         my %itemtypes;
 165         while ( my $IT = $sth->fetchrow_hashref ) {
 166             $itemtypes{ $IT->{'itemtype'} } = $IT;
 167         }
 168         return ( \%itemtypes );
 169     } else {
 170         return [ sort { lc $a->{translated_description} cmp lc $b->{translated_description} } @{ $sth->fetchall_arrayref( {} ) } ];
 171     }
 172 }
 173
 174 =head2 GetItemTypesCategorized
 175
 176     $categories = GetItemTypesCategorized();
 177
 178 Returns a hashref containing search categories.
 179 A search category will be put in the hash if at least one of its itemtypes is visible in OPAC.
 180 The categories must be part of Authorized Values (ITEMTYPECAT)
 181
 182 =cut
 183
 184 sub GetItemTypesCategorized {
 185     my $dbh   = C4::Context->dbh;
 186     # Order is important, so that partially hidden (some items are not visible in OPAC) search
 187     # categories will be visible. hideinopac=0 must be last.
 188     my $query = q|
 189         SELECT itemtype, description, imageurl, hideinopac, 0 as 'iscat' FROM itemtypes WHERE ISNULL(searchcategory) or length(searchcategory) = 0
 190         UNION
 191         SELECT DISTINCT searchcategory AS `itemtype`,
 192                         authorised_values.lib_opac AS description,
 193                         authorised_values.imageurl AS imageurl,
 194                         hideinopac, 1 as 'iscat'
 195         FROM itemtypes
 196         LEFT JOIN authorised_values ON searchcategory = authorised_value
 197         WHERE searchcategory > '' and hideinopac=1
 198         UNION
 199         SELECT DISTINCT searchcategory AS `itemtype`,
 200                         authorised_values.lib_opac AS description,
 201                         authorised_values.imageurl AS imageurl,
 202                         hideinopac, 1 as 'iscat'
 203         FROM itemtypes
 204         LEFT JOIN authorised_values ON searchcategory = authorised_value
 205         WHERE searchcategory > '' and hideinopac=0
 206         |;
 207 return ($dbh->selectall_hashref($query,'itemtype'));
 208 }
 209
 210 =head2 GetItemTypesByCategory
 211
 212     @results = GetItemTypesByCategory( $searchcategory );
 213
 214 Returns the itemtype code of all itemtypes included in a searchcategory.
 215
 216 =cut
 217
 218 sub GetItemTypesByCategory {
 219     my ($category) = @_;
 220     my $count = 0;
 221     my @results;
 222     my $dbh = C4::Context->dbh;
 223     my $query = qq|SELECT itemtype FROM itemtypes WHERE searchcategory=?|;
 224     my $tmp=$dbh->selectcol_arrayref($query,undef,$category);
 225     return @$tmp;
 226 }
 227
 228 =head2 getframework
 229
 230   $frameworks = &getframework();
 231
 232 Returns information about existing frameworks
 233
 234 build a HTML select with the following code :
 235
 236 =head3 in PERL SCRIPT
 237
 238   my $frameworks = getframeworks();
 239   my @frameworkloop;
 240   foreach my $thisframework (keys %$frameworks) {
 241     my $selected = 1 if $thisframework eq $frameworkcode;
 242     my %row =(
 243                 value       => $thisframework,
 244                 selected    => $selected,
 245                 description => $frameworks->{$thisframework}->{'frameworktext'},
 246             );
 247     push @frameworksloop, \%row;
 248   }
 249   $template->param(frameworkloop => \@frameworksloop);
 250
 251 =head3 in TEMPLATE
 252
 253   <form action="[% script_name %] method=post>
 254     <select name="frameworkcode">
 255         <option value="">Default</option>
 256         [% FOREACH framework IN frameworkloop %]
 257         [% IF ( framework.selected ) %]
 258         <option value="[% framework.value %]" selected="selected">[% framework.description %]</option>
 259         [% ELSE %]
 260         <option value="[% framework.value %]">[% framework.description %]</option>
 261         [% END %]
 262         [% END %]
 263     </select>
 264     <input type=text name=searchfield value="[% searchfield %]">
 265     <input type="submit" value="OK" class="button">
 266   </form>
 267
 268 =cut
 269
 270 sub getframeworks {
 271
 272     # returns a reference to a hash of references to branches...
 273     my %itemtypes;
 274     my $dbh = C4::Context->dbh;
 275     my $sth = $dbh->prepare("select * from biblio_framework");
 276     $sth->execute;
 277     while ( my $IT = $sth->fetchrow_hashref ) {
 278         $itemtypes{ $IT->{'frameworkcode'} } = $IT;
 279     }
 280     return ( \%itemtypes );
 281 }
 282
 283 =head2 GetFrameworksLoop
 284
 285   $frameworks = GetFrameworksLoop( $frameworkcode );
 286
 287 Returns the loop suggested on getframework(), but ordered by framework description.
 288
 289 build a HTML select with the following code :
 290
 291 =head3 in PERL SCRIPT
 292
 293   $template->param( frameworkloop => GetFrameworksLoop( $frameworkcode ) );
 294
 295 =head3 in TEMPLATE
 296
 297   Same as getframework()
 298
 299   <form action="[% script_name %] method=post>
 300     <select name="frameworkcode">
 301         <option value="">Default</option>
 302         [% FOREACH framework IN frameworkloop %]
 303         [% IF ( framework.selected ) %]
 304         <option value="[% framework.value %]" selected="selected">[% framework.description %]</option>
 305         [% ELSE %]
 306         <option value="[% framework.value %]">[% framework.description %]</option>
 307         [% END %]
 308         [% END %]
 309     </select>
 310     <input type=text name=searchfield value="[% searchfield %]">
 311     <input type="submit" value="OK" class="button">
 312   </form>
 313
 314 =cut
 315
 316 sub GetFrameworksLoop {
 317     my $frameworkcode = shift;
 318     my $frameworks = getframeworks();
 319     my @frameworkloop;
 320     foreach my $thisframework (sort { uc($frameworks->{$a}->{'frameworktext'}) cmp uc($frameworks->{$b}->{'frameworktext'}) } keys %$frameworks) {
 321         my $selected = ( $thisframework eq $frameworkcode ) ? 1 : undef;
 322         my %row = (
 323                 value       => $thisframework,
 324                 selected    => $selected,
 325                 description => $frameworks->{$thisframework}->{'frameworktext'},
 326             );
 327         push @frameworkloop, \%row;
 328   }
 329   return \@frameworkloop;
 330 }
 331
 332 =head2 getframeworkinfo
 333
 334   $frameworkinfo = &getframeworkinfo($frameworkcode);
 335
 336 Returns information about an frameworkcode.
 337
 338 =cut
 339
 340 sub getframeworkinfo {
 341     my ($frameworkcode) = @_;
 342     my $dbh             = C4::Context->dbh;
 343     my $sth             =
 344       $dbh->prepare("select * from biblio_framework where frameworkcode=?");
 345     $sth->execute($frameworkcode);
 346     my $res = $sth->fetchrow_hashref;
 347     return $res;
 348 }
 349
 350 =head2 getitemtypeinfo
 351
 352   $itemtype = &getitemtypeinfo($itemtype, [$interface]);
 353
 354 Returns information about an itemtype. The optional $interface argument
 355 sets which interface ('opac' or 'intranet') to return the imageurl for.
 356 Defaults to intranet.
 357
 358 =cut
 359
 360 sub getitemtypeinfo {
 361     my ($itemtype, $interface) = @_;
 362     my $dbh      = C4::Context->dbh;
 363     require C4::Languages;
 364     my $language = C4::Languages::getlanguage();
 365     my $it = $dbh->selectrow_hashref(q|
 366         SELECT
 367                itemtypes.itemtype,
 368                itemtypes.description,
 369                itemtypes.rentalcharge,
 370                itemtypes.notforloan,
 371                itemtypes.imageurl,
 372                itemtypes.summary,
 373                itemtypes.checkinmsg,
 374                itemtypes.checkinmsgtype,
 375                itemtypes.sip_media_type,
 376                COALESCE( localization.translation, itemtypes.description ) AS translated_description
 377         FROM   itemtypes
 378         LEFT JOIN localization ON itemtypes.itemtype = localization.code
 379             AND localization.entity = 'itemtypes'
 380             AND localization.lang = ?
 381         WHERE itemtypes.itemtype = ?
 382     |, undef, $language, $itemtype );
 383
 384     $it->{imageurl} = getitemtypeimagelocation( ( ( defined $interface && $interface eq 'opac' ) ? 'opac' : 'intranet' ), $it->{imageurl} );
 385
 386     return $it;
 387 }
 388
 389 =head2 getitemtypeimagedir
 390
 391   my $directory = getitemtypeimagedir( 'opac' );
 392
 393 pass in 'opac' or 'intranet'. Defaults to 'opac'.
 394
 395 returns the full path to the appropriate directory containing images.
 396
 397 =cut
 398
 399 sub getitemtypeimagedir {
 400         my $src = shift || 'opac';
 401         if ($src eq 'intranet') {
 402                 return C4::Context->config('intrahtdocs') . '/' .C4::Context->preference('template') . '/img/itemtypeimg';
 403         } else {
 404                 return C4::Context->config('opachtdocs') . '/' . C4::Context->preference('opacthemes') . '/itemtypeimg';
 405         }
 406 }
 407
 408 sub getitemtypeimagesrc {
 409         my $src = shift || 'opac';
 410         if ($src eq 'intranet') {
 411                 return '/intranet-tmpl' . '/' . C4::Context->preference('template') . '/img/itemtypeimg';
 412         } else {
 413                 return '/opac-tmpl' . '/' . C4::Context->preference('opacthemes') . '/itemtypeimg';
 414         }
 415 }
 416
 417 sub getitemtypeimagelocation {
 418         my ( $src, $image ) = @_;
 419
 420         return '' if ( !$image );
 421     require URI::Split;
 422
 423         my $scheme = ( URI::Split::uri_split( $image ) )[0];
 424
 425         return $image if ( $scheme );
 426
 427         return getitemtypeimagesrc( $src ) . '/' . $image;
 428 }
 429
 430 =head3 _getImagesFromDirectory
 431
 432 Find all of the image files in a directory in the filesystem
 433
 434 parameters: a directory name
 435
 436 returns: a list of images in that directory.
 437
 438 Notes: this does not traverse into subdirectories. See
 439 _getSubdirectoryNames for help with that.
 440 Images are assumed to be files with .gif or .png file extensions.
 441 The image names returned do not have the directory name on them.
 442
 443 =cut
 444
 445 sub _getImagesFromDirectory {
 446     my $directoryname = shift;
 447     return unless defined $directoryname;
 448     return unless -d $directoryname;
 449
 450     if ( opendir ( my $dh, $directoryname ) ) {
 451         my @images = grep { /\.(gif|png)$/i } readdir( $dh );
 452         closedir $dh;
 453         @images = sort(@images);
 454         return @images;
 455     } else {
 456         warn "unable to opendir $directoryname: $!";
 457         return;
 458     }
 459 }
 460
 461 =head3 _getSubdirectoryNames
 462
 463 Find all of the directories in a directory in the filesystem
 464
 465 parameters: a directory name
 466
 467 returns: a list of subdirectories in that directory.
 468
 469 Notes: this does not traverse into subdirectories. Only the first
 470 level of subdirectories are returned.
 471 The directory names returned don't have the parent directory name on them.
 472
 473 =cut
 474
 475 sub _getSubdirectoryNames {
 476     my $directoryname = shift;
 477     return unless defined $directoryname;
 478     return unless -d $directoryname;
 479
 480     if ( opendir ( my $dh, $directoryname ) ) {
 481         my @directories = grep { -d File::Spec->catfile( $directoryname, $_ ) && ! ( /^\./ ) } readdir( $dh );
 482         closedir $dh;
 483         return @directories;
 484     } else {
 485         warn "unable to opendir $directoryname: $!";
 486         return;
 487     }
 488 }
 489
 490 =head3 getImageSets
 491
 492 returns: a listref of hashrefs. Each hash represents another collection of images.
 493
 494  { imagesetname => 'npl', # the name of the image set (npl is the original one)
 495          images => listref of image hashrefs
 496  }
 497
 498 each image is represented by a hashref like this:
 499
 500  { KohaImage     => 'npl/image.gif',
 501    StaffImageUrl => '/intranet-tmpl/prog/img/itemtypeimg/npl/image.gif',
 502    OpacImageURL  => '/opac-tmpl/prog/itemtypeimg/npl/image.gif'
 503    checked       => 0 or 1: was this the image passed to this method?
 504                     Note: I'd like to remove this somehow.
 505  }
 506
 507 =cut
 508
 509 sub getImageSets {
 510     my %params = @_;
 511     my $checked = $params{'checked'} || '';
 512
 513     my $paths = { staff => { filesystem => getitemtypeimagedir('intranet'),
 514                              url        => getitemtypeimagesrc('intranet'),
 515                         },
 516                   opac => { filesystem => getitemtypeimagedir('opac'),
 517                              url       => getitemtypeimagesrc('opac'),
 518                         }
 519                   };
 520
 521     my @imagesets = (); # list of hasrefs of image set data to pass to template
 522     my @subdirectories = _getSubdirectoryNames( $paths->{'staff'}{'filesystem'} );
 523     foreach my $imagesubdir ( @subdirectories ) {
 524     warn $imagesubdir if $DEBUG;
 525         my @imagelist     = (); # hashrefs of image info
 526         my @imagenames = _getImagesFromDirectory( File::Spec->catfile( $paths->{'staff'}{'filesystem'}, $imagesubdir ) );
 527         my $imagesetactive = 0;
 528         foreach my $thisimage ( @imagenames ) {
 529             push( @imagelist,
 530                   { KohaImage     => "$imagesubdir/$thisimage",
 531                     StaffImageUrl => join( '/', $paths->{'staff'}{'url'}, $imagesubdir, $thisimage ),
 532                     OpacImageUrl  => join( '/', $paths->{'opac'}{'url'}, $imagesubdir, $thisimage ),
 533                     checked       => "$imagesubdir/$thisimage" eq $checked ? 1 : 0,
 534                }
 535              );
 536              $imagesetactive = 1 if "$imagesubdir/$thisimage" eq $checked;
 537         }
 538         push @imagesets, { imagesetname => $imagesubdir,
 539                            imagesetactive => $imagesetactive,
 540                            images       => \@imagelist };
 541
 542     }
 543     return \@imagesets;
 544 }
 545
 546 =head2 GetPrinters
 547
 548   $printers = &GetPrinters();
 549   @queues = keys %$printers;
 550
 551 Returns information about existing printer queues.
 552
 553 C<$printers> is a reference-to-hash whose keys are the print queues
 554 defined in the printers table of the Koha database. The values are
 555 references-to-hash, whose keys are the fields in the printers table.
 556
 557 =cut
 558
 559 sub GetPrinters {
 560     my %printers;
 561     my $dbh = C4::Context->dbh;
 562     my $sth = $dbh->prepare("select * from printers");
 563     $sth->execute;
 564     while ( my $printer = $sth->fetchrow_hashref ) {
 565         $printers{ $printer->{'printqueue'} } = $printer;
 566     }
 567     return ( \%printers );
 568 }
 569
 570 =head2 GetPrinter
 571
 572   $printer = GetPrinter( $query, $printers );
 573
 574 =cut
 575
 576 sub GetPrinter {
 577     my ( $query, $printers ) = @_;    # get printer for this query from printers
 578     my $printer = $query->param('printer');
 579     my %cookie = $query->cookie('userenv');
 580     ($printer) || ( $printer = $cookie{'printer'} ) || ( $printer = '' );
 581     ( $printers->{$printer} ) || ( $printer = ( keys %$printers )[0] );
 582     return $printer;
 583 }
 584
 585 =head2 getnbpages
 586
 587 Returns the number of pages to display in a pagination bar, given the number
 588 of items and the number of items per page.
 589
 590 =cut
 591
 592 sub getnbpages {
 593     my ( $nb_items, $nb_items_per_page ) = @_;
 594
 595     return int( ( $nb_items - 1 ) / $nb_items_per_page ) + 1;
 596 }
 597
 598 =head2 getallthemes
 599
 600   (@themes) = &getallthemes('opac');
 601   (@themes) = &getallthemes('intranet');
 602
 603 Returns an array of all available themes.
 604
 605 =cut
 606
 607 sub getallthemes {
 608     my $type = shift;
 609     my $htdocs;
 610     my @themes;
 611     if ( $type eq 'intranet' ) {
 612         $htdocs = C4::Context->config('intrahtdocs');
 613     }
 614     else {
 615         $htdocs = C4::Context->config('opachtdocs');
 616     }
 617     opendir D, "$htdocs";
 618     my @dirlist = readdir D;
 619     foreach my $directory (@dirlist) {
 620         next if $directory eq 'lib';
 621         -d "$htdocs/$directory/en" and push @themes, $directory;
 622     }
 623     return @themes;
 624 }
 625
 626 sub getFacets {
 627     my $facets;
 628     if ( C4::Context->preference("marcflavour") eq "UNIMARC" ) {
 629         $facets = [
 630             {
 631                 idx   => 'su-to',
 632                 label => 'Topics',
 633                 tags  => [ qw/ 600ab 601ab 602a 604at 605a 606ax 610a / ],
 634                 sep   => ' - ',
 635             },
 636             {
 637                 idx   => 'su-geo',
 638                 label => 'Places',
 639                 tags  => [ qw/ 607a / ],
 640                 sep   => ' - ',
 641             },
 642             {
 643                 idx   => 'su-ut',
 644                 label => 'Titles',
 645                 tags  => [ qw/ 500a 501a 503a / ],
 646                 sep   => ', ',
 647             },
 648             {
 649                 idx   => 'au',
 650                 label => 'Authors',
 651                 tags  => [ qw/ 700ab 701ab 702ab / ],
 652                 sep   => C4::Context->preference("UNIMARCAuthorsFacetsSeparator"),
 653             },
 654             {
 655                 idx   => 'se',
 656                 label => 'Series',
 657                 tags  => [ qw/ 225a / ],
 658                 sep   => ', ',
 659             },
 660             {
 661                 idx  => 'location',
 662                 label => 'Location',
 663                 tags        => [ qw/ 995e / ],
 664             }
 665             ];
 666
 667             unless ( Koha::Libraries->search->count == 1 )
 668             {
 669                 my $DisplayLibraryFacets = C4::Context->preference('DisplayLibraryFacets');
 670                 if (   $DisplayLibraryFacets eq 'both'
 671                     || $DisplayLibraryFacets eq 'holding' )
 672                 {
 673                     push(
 674                         @$facets,
 675                         {
 676                             idx   => 'holdingbranch',
 677                             label => 'HoldingLibrary',
 678                             tags  => [qw / 995c /],
 679                         }
 680                     );
 681                 }
 682
 683                 if (   $DisplayLibraryFacets eq 'both'
 684                     || $DisplayLibraryFacets eq 'home' )
 685                 {
 686                 push(
 687                     @$facets,
 688                     {
 689                         idx   => 'homebranch',
 690                         label => 'HomeLibrary',
 691                         tags  => [qw / 995b /],
 692                     }
 693                 );
 694                 }
 695             }
 696     }
 697     else {
 698         $facets = [
 699             {
 700                 idx   => 'su-to',
 701                 label => 'Topics',
 702                 tags  => [ qw/ 650a / ],
 703                 sep   => '--',
 704             },
 705             #        {
 706             #        idx   => 'su-na',
 707             #        label => 'People and Organizations',
 708             #        tags  => [ qw/ 600a 610a 611a / ],
 709             #        sep   => 'a',
 710             #        },
 711             {
 712                 idx   => 'su-geo',
 713                 label => 'Places',
 714                 tags  => [ qw/ 651a / ],
 715                 sep   => '--',
 716             },
 717             {
 718                 idx   => 'su-ut',
 719                 label => 'Titles',
 720                 tags  => [ qw/ 630a / ],
 721                 sep   => '--',
 722             },
 723             {
 724                 idx   => 'au',
 725                 label => 'Authors',
 726                 tags  => [ qw/ 100a 110a 700a / ],
 727                 sep   => ', ',
 728             },
 729             {
 730                 idx   => 'se',
 731                 label => 'Series',
 732                 tags  => [ qw/ 440a 490a / ],
 733                 sep   => ', ',
 734             },
 735             {
 736                 idx   => 'itype',
 737                 label => 'ItemTypes',
 738                 tags  => [ qw/ 952y 942c / ],
 739                 sep   => ', ',
 740             },
 741             {
 742                 idx => 'location',
 743                 label => 'Location',
 744                 tags => [ qw / 952c / ],
 745             },
 746             ];
 747
 748             unless ( Koha::Libraries->search->count == 1 )
 749             {
 750                 my $DisplayLibraryFacets = C4::Context->preference('DisplayLibraryFacets');
 751                 if (   $DisplayLibraryFacets eq 'both'
 752                     || $DisplayLibraryFacets eq 'holding' )
 753                 {
 754                     push(
 755                         @$facets,
 756                         {
 757                             idx   => 'holdingbranch',
 758                             label => 'HoldingLibrary',
 759                             tags  => [qw / 952b /],
 760                         }
 761                     );
 762                 }
 763
 764                 if (   $DisplayLibraryFacets eq 'both'
 765                     || $DisplayLibraryFacets eq 'home' )
 766                 {
 767                 push(
 768                     @$facets,
 769                     {
 770                         idx   => 'homebranch',
 771                         label => 'HomeLibrary',
 772                         tags  => [qw / 952a /],
 773                     }
 774                 );
 775                 }
 776             }
 777     }
 778     return $facets;
 779 }
 780
 781 =head2 get_infos_of
 782
 783 Return a href where a key is associated to a href. You give a query,
 784 the name of the key among the fields returned by the query. If you
 785 also give as third argument the name of the value, the function
 786 returns a href of scalar. The optional 4th argument is an arrayref of
 787 items passed to the C<execute()> call. It is designed to bind
 788 parameters to any placeholders in your SQL.
 789
 790   my $query = '
 791 SELECT itemnumber,
 792        notforloan,
 793        barcode
 794   FROM items
 795 ';
 796
 797   # generic href of any information on the item, href of href.
 798   my $iteminfos_of = get_infos_of($query, 'itemnumber');
 799   print $iteminfos_of->{$itemnumber}{barcode};
 800
 801   # specific information, href of scalar
 802   my $barcode_of_item = get_infos_of($query, 'itemnumber', 'barcode');
 803   print $barcode_of_item->{$itemnumber};
 804
 805 =cut
 806
 807 sub get_infos_of {
 808     my ( $query, $key_name, $value_name, $bind_params ) = @_;
 809
 810     my $dbh = C4::Context->dbh;
 811
 812     my $sth = $dbh->prepare($query);
 813     $sth->execute( @$bind_params );
 814
 815     my %infos_of;
 816     while ( my $row = $sth->fetchrow_hashref ) {
 817         if ( defined $value_name ) {
 818             $infos_of{ $row->{$key_name} } = $row->{$value_name};
 819         }
 820         else {
 821             $infos_of{ $row->{$key_name} } = $row;
 822         }
 823     }
 824     $sth->finish;
 825
 826     return \%infos_of;
 827 }
 828
 829 =head2 get_notforloan_label_of
 830
 831   my $notforloan_label_of = get_notforloan_label_of();
 832
 833 Each authorised value of notforloan (information available in items and
 834 itemtypes) is link to a single label.
 835
 836 Returns a href where keys are authorised values and values are corresponding
 837 labels.
 838
 839   foreach my $authorised_value (keys %{$notforloan_label_of}) {
 840     printf(
 841         "authorised_value: %s => %s\n",
 842         $authorised_value,
 843         $notforloan_label_of->{$authorised_value}
 844     );
 845   }
 846
 847 =cut
 848
 849 # FIXME - why not use GetAuthorisedValues ??
 850 #
 851 sub get_notforloan_label_of {
 852     my $dbh = C4::Context->dbh;
 853
 854     my $query = '
 855 SELECT authorised_value
 856   FROM marc_subfield_structure
 857   WHERE kohafield = \'items.notforloan\'
 858   LIMIT 0, 1
 859 ';
 860     my $sth = $dbh->prepare($query);
 861     $sth->execute();
 862     my ($statuscode) = $sth->fetchrow_array();
 863
 864     $query = '
 865 SELECT lib,
 866        authorised_value
 867   FROM authorised_values
 868   WHERE category = ?
 869 ';
 870     $sth = $dbh->prepare($query);
 871     $sth->execute($statuscode);
 872     my %notforloan_label_of;
 873     while ( my $row = $sth->fetchrow_hashref ) {
 874         $notforloan_label_of{ $row->{authorised_value} } = $row->{lib};
 875     }
 876     $sth->finish;
 877
 878     return \%notforloan_label_of;
 879 }
 880
 881 =head2 GetAuthorisedValues
 882
 883   $authvalues = GetAuthorisedValues([$category]);
 884
 885 This function returns all authorised values from the'authorised_value' table in a reference to array of hashrefs.
 886
 887 C<$category> returns authorised values for just one category (optional).
 888
 889 C<$opac> If set to a true value, displays OPAC descriptions rather than normal ones when they exist.
 890
 891 =cut
 892
 893 sub GetAuthorisedValues {
 894     my ( $category, $opac ) = @_;
 895
 896     # Is this cached already?
 897     $opac = $opac ? 1 : 0;    # normalise to be safe
 898     my $branch_limit =
 899       C4::Context->userenv ? C4::Context->userenv->{"branch"} : "";
 900     my $cache_key =
 901       "AuthorisedValues-$category-$opac-$branch_limit";
 902     my $cache  = Koha::Caches->get_instance();
 903     my $result = $cache->get_from_cache($cache_key);
 904     return $result if $result;
 905
 906     my @results;
 907     my $dbh      = C4::Context->dbh;
 908     my $query = qq{
 909         SELECT DISTINCT av.*
 910         FROM authorised_values av
 911     };
 912     $query .= qq{
 913           LEFT JOIN authorised_values_branches ON ( id = av_id )
 914     } if $branch_limit;
 915     my @where_strings;
 916     my @where_args;
 917     if($category) {
 918         push @where_strings, "category = ?";
 919         push @where_args, $category;
 920     }
 921     if($branch_limit) {
 922         push @where_strings, "( branchcode = ? OR branchcode IS NULL )";
 923         push @where_args, $branch_limit;
 924     }
 925     if(@where_strings > 0) {
 926         $query .= " WHERE " . join(" AND ", @where_strings);
 927     }
 928     $query .= ' ORDER BY category, ' . (
 929                 $opac ? 'COALESCE(lib_opac, lib)'
 930                       : 'lib, lib_opac'
 931               );
 932
 933     my $sth = $dbh->prepare($query);
 934
 935     $sth->execute( @where_args );
 936     while (my $data=$sth->fetchrow_hashref) {
 937         if ($opac && $data->{lib_opac}) {
 938             $data->{lib} = $data->{lib_opac};
 939         }
 940         push @results, $data;
 941     }
 942     $sth->finish;
 943
 944     $cache->set_in_cache( $cache_key, \@results, { expiry => 5 } );
 945     return \@results;
 946 }
 947
 948 =head2 GetAuthorisedValueCategories
 949
 950   $auth_categories = GetAuthorisedValueCategories();
 951
 952 Return an arrayref of all of the available authorised
 953 value categories.
 954
 955 =cut
 956
 957 sub GetAuthorisedValueCategories {
 958     my $dbh = C4::Context->dbh;
 959     my $sth = $dbh->prepare("SELECT DISTINCT category FROM authorised_values ORDER BY category");
 960     $sth->execute;
 961     my @results;
 962     while (defined (my $category  = $sth->fetchrow_array) ) {
 963         push @results, $category;
 964     }
 965     return \@results;
 966 }
 967
 968 =head2 GetKohaAuthorisedValues
 969
 970 Takes $kohafield, $fwcode as parameters.
 971
 972 If $opac parameter is set to a true value, displays OPAC descriptions rather than normal ones when they exist.
 973
 974 Returns hashref of Code => description
 975
 976 Returns undef if no authorised value category is defined for the kohafield.
 977
 978 =cut
 979
 980 sub GetKohaAuthorisedValues {
 981     my ( $kohafield, $fwcode, $opac ) = @_;
 982     $fwcode = '' unless $fwcode;
 983     my %values;
 984     my $dbh = C4::Context->dbh;
 985
 986     my $avs = Koha::AuthorisedValues->search_by_koha_field( { frameworkcode => $fwcode, kohafield => $kohafield } );
 987     return {} unless $avs->count;
 988     my $values;
 989     while ( my $av = $avs->next ) {
 990         $values->{ $av->authorised_value } = $opac ? $av->opac_description : $av->lib;
 991     }
 992     return $values;
 993 }
 994
 995 =head2 xml_escape
 996
 997   my $escaped_string = C4::Koha::xml_escape($string);
 998
 999 Convert &, <, >, ', and " in a string to XML entities
1000
1001 =cut
1002
1003 sub xml_escape {
1004     my $str = shift;
1005     return '' unless defined $str;
1006     $str =~ s/&/&amp;/g;
1007     $str =~ s/</&lt;/g;
1008     $str =~ s/>/&gt;/g;
1009     $str =~ s/'/&apos;/g;
1010     $str =~ s/"/&quot;/g;
1011     return $str;
1012 }
1013
1014 =head2 display_marc_indicators
1015
1016   my $display_form = C4::Koha::display_marc_indicators($field);
1017
1018 C<$field> is a MARC::Field object
1019
1020 Generate a display form of the indicators of a variable
1021 MARC field, replacing any blanks with '#'.
1022
1023 =cut
1024
1025 sub display_marc_indicators {
1026     my $field = shift;
1027     my $indicators = '';
1028     if ($field && $field->tag() >= 10) {
1029         $indicators = $field->indicator(1) . $field->indicator(2);
1030         $indicators =~ s/ /#/g;
1031     }
1032     return $indicators;
1033 }
1034
1035 sub GetNormalizedUPC {
1036     my ($marcrecord,$marcflavour) = @_;
1037
1038     return unless $marcrecord;
1039     if ($marcflavour eq 'UNIMARC') {
1040         my @fields = $marcrecord->field('072');
1041         foreach my $field (@fields) {
1042             my $upc = _normalize_match_point($field->subfield('a'));
1043             if ($upc) {
1044                 return $upc;
1045             }
1046         }
1047
1048     }
1049     else { # assume marc21 if not unimarc
1050         my @fields = $marcrecord->field('024');
1051         foreach my $field (@fields) {
1052             my $indicator = $field->indicator(1);
1053             my $upc = _normalize_match_point($field->subfield('a'));
1054             if ($upc && $indicator == 1 ) {
1055                 return $upc;
1056             }
1057         }
1058     }
1059 }
1060
1061 # Normalizes and returns the first valid ISBN found in the record
1062 # ISBN13 are converted into ISBN10. This is required to get some book cover images.
1063 sub GetNormalizedISBN {
1064     my ($isbn,$marcrecord,$marcflavour) = @_;
1065     if ($isbn) {
1066         # Koha attempts to store multiple ISBNs in biblioitems.isbn, separated by " | "
1067         # anything after " | " should be removed, along with the delimiter
1068         ($isbn) = split(/\|/, $isbn );
1069         return _isbn_cleanup($isbn);
1070     }
1071
1072     return unless $marcrecord;
1073
1074     if ($marcflavour eq 'UNIMARC') {
1075         my @fields = $marcrecord->field('010');
1076         foreach my $field (@fields) {
1077             my $isbn = $field->subfield('a');
1078             if ($isbn) {
1079                 return _isbn_cleanup($isbn);
1080             }
1081         }
1082     }
1083     else { # assume marc21 if not unimarc
1084         my @fields = $marcrecord->field('020');
1085         foreach my $field (@fields) {
1086             $isbn = $field->subfield('a');
1087             if ($isbn) {
1088                 return _isbn_cleanup($isbn);
1089             }
1090         }
1091     }
1092 }
1093
1094 sub GetNormalizedEAN {
1095     my ($marcrecord,$marcflavour) = @_;
1096
1097     return unless $marcrecord;
1098
1099     if ($marcflavour eq 'UNIMARC') {
1100         my @fields = $marcrecord->field('073');
1101         foreach my $field (@fields) {
1102             my $ean = _normalize_match_point($field->subfield('a'));
1103             if ( $ean ) {
1104                 return $ean;
1105             }
1106         }
1107     }
1108     else { # assume marc21 if not unimarc
1109         my @fields = $marcrecord->field('024');
1110         foreach my $field (@fields) {
1111             my $indicator = $field->indicator(1);
1112             my $ean = _normalize_match_point($field->subfield('a'));
1113             if ( $ean && $indicator == 3  ) {
1114                 return $ean;
1115             }
1116         }
1117     }
1118 }
1119
1120 sub GetNormalizedOCLCNumber {
1121     my ($marcrecord,$marcflavour) = @_;
1122     return unless $marcrecord;
1123
1124     if ($marcflavour ne 'UNIMARC' ) {
1125         my @fields = $marcrecord->field('035');
1126         foreach my $field (@fields) {
1127             my $oclc = $field->subfield('a');
1128             if ($oclc =~ /OCoLC/) {
1129                 $oclc =~ s/\(OCoLC\)//;
1130                 return $oclc;
1131             }
1132         }
1133     } else {
1134         # TODO for UNIMARC
1135     }
1136     return
1137 }
1138
1139 sub GetAuthvalueDropbox {
1140     my ( $authcat, $default ) = @_;
1141     my $branch_limit = C4::Context->userenv ? C4::Context->userenv->{"branch"} : "";
1142     my $dbh = C4::Context->dbh;
1143
1144     my $query = qq{
1145         SELECT *
1146         FROM authorised_values
1147     };
1148     $query .= qq{
1149           LEFT JOIN authorised_values_branches ON ( id = av_id )
1150     } if $branch_limit;
1151     $query .= qq{
1152         WHERE category = ?
1153     };
1154     $query .= " AND ( branchcode = ? OR branchcode IS NULL )" if $branch_limit;
1155     $query .= " GROUP BY lib ORDER BY category, lib, lib_opac";
1156     my $sth = $dbh->prepare($query);
1157     $sth->execute( $authcat, $branch_limit ? $branch_limit : () );
1158
1159
1160     my $option_list = [];
1161     my @authorised_values = ( q{} );
1162     while (my $av = $sth->fetchrow_hashref) {
1163         push @{$option_list}, {
1164             value => $av->{authorised_value},
1165             label => $av->{lib},
1166             default => ($default eq $av->{authorised_value}),
1167         };
1168     }
1169
1170     if ( @{$option_list} ) {
1171         return $option_list;
1172     }
1173     return;
1174 }
1175
1176
1177 =head2 GetDailyQuote($opts)
1178
1179 Takes a hashref of options
1180
1181 Currently supported options are:
1182
1183 'id'        An exact quote id
1184 'random'    Select a random quote
1185 noop        When no option is passed in, this sub will return the quote timestamped for the current day
1186
1187 The function returns an anonymous hash following this format:
1188
1189         {
1190           'source' => 'source-of-quote',
1191           'timestamp' => 'timestamp-value',
1192           'text' => 'text-of-quote',
1193           'id' => 'quote-id'
1194         };
1195
1196 =cut
1197
1198 # This is definitely a candidate for some sort of caching once we finally settle caching/persistence issues...
1199 # at least for default option
1200
1201 sub GetDailyQuote {
1202     my %opts = @_;
1203     my $dbh = C4::Context->dbh;
1204     my $query = '';
1205     my $sth = undef;
1206     my $quote = undef;
1207     if ($opts{'id'}) {
1208         $query = 'SELECT * FROM quotes WHERE id = ?';
1209         $sth = $dbh->prepare($query);
1210         $sth->execute($opts{'id'});
1211         $quote = $sth->fetchrow_hashref();
1212     }
1213     elsif ($opts{'random'}) {
1214         # Fall through... we also return a random quote as a catch-all if all else fails
1215     }
1216     else {
1217         $query = 'SELECT * FROM quotes WHERE timestamp LIKE CONCAT(CURRENT_DATE,\'%\') ORDER BY timestamp DESC LIMIT 0,1';
1218         $sth = $dbh->prepare($query);
1219         $sth->execute();
1220         $quote = $sth->fetchrow_hashref();
1221     }
1222     unless ($quote) {        # if there are not matches, choose a random quote
1223         # get a list of all available quote ids
1224         $sth = C4::Context->dbh->prepare('SELECT count(*) FROM quotes;');
1225         $sth->execute;
1226         my $range = ($sth->fetchrow_array)[0];
1227         # chose a random id within that range if there is more than one quote
1228         my $offset = int(rand($range));
1229         # grab it
1230         $query = 'SELECT * FROM quotes ORDER BY id LIMIT 1 OFFSET ?';
1231         $sth = C4::Context->dbh->prepare($query);
1232         # see http://www.perlmonks.org/?node_id=837422 for why
1233         # we're being verbose and using bind_param
1234         $sth->bind_param(1, $offset, SQL_INTEGER);
1235         $sth->execute();
1236         $quote = $sth->fetchrow_hashref();
1237         # update the timestamp for that quote
1238         $query = 'UPDATE quotes SET timestamp = ? WHERE id = ?';
1239         $sth = C4::Context->dbh->prepare($query);
1240         $sth->execute(
1241             DateTime::Format::MySQL->format_datetime( dt_from_string() ),
1242             $quote->{'id'}
1243         );
1244     }
1245     return $quote;
1246 }
1247
1248 sub _normalize_match_point {
1249     my $match_point = shift;
1250     (my $normalized_match_point) = $match_point =~ /([\d-]*[X]*)/;
1251     $normalized_match_point =~ s/-//g;
1252
1253     return $normalized_match_point;
1254 }
1255
1256 sub _isbn_cleanup {
1257     my ($isbn) = @_;
1258     return NormalizeISBN(
1259         {
1260             isbn          => $isbn,
1261             format        => 'ISBN-10',
1262             strip_hyphens => 1,
1263         }
1264     ) if $isbn;
1265 }
1266
1267 =head2 NormalizedISBN
1268
1269   my $isbns = NormalizedISBN({
1270     isbn => $isbn,
1271     strip_hyphens => [0,1],
1272     format => ['ISBN-10', 'ISBN-13']
1273   });
1274
1275   Returns an isbn validated by Business::ISBN.
1276   Optionally strips hyphens and/or forces the isbn
1277   to be of the specified format.
1278
1279   If the string cannot be validated as an isbn,
1280   it returns nothing.
1281
1282 =cut
1283
1284 sub NormalizeISBN {
1285     my ($params) = @_;
1286
1287     my $string        = $params->{isbn};
1288     my $strip_hyphens = $params->{strip_hyphens};
1289     my $format        = $params->{format};
1290
1291     return unless $string;
1292
1293     my $isbn = Business::ISBN->new($string);
1294
1295     if ( $isbn && $isbn->is_valid() ) {
1296
1297         if ( $format eq 'ISBN-10' ) {
1298             $isbn = $isbn->as_isbn10();
1299         }
1300         elsif ( $format eq 'ISBN-13' ) {
1301             $isbn = $isbn->as_isbn13();
1302         }
1303         return unless $isbn;
1304
1305         if ($strip_hyphens) {
1306             $string = $isbn->as_string( [] );
1307         } else {
1308             $string = $isbn->as_string();
1309         }
1310
1311         return $string;
1312     }
1313 }
1314
1315 =head2 GetVariationsOfISBN
1316
1317   my @isbns = GetVariationsOfISBN( $isbn );
1318
1319   Returns a list of variations of the given isbn in
1320   both ISBN-10 and ISBN-13 formats, with and without
1321   hyphens.
1322
1323   In a scalar context, the isbns are returned as a
1324   string delimited by ' | '.
1325
1326 =cut
1327
1328 sub GetVariationsOfISBN {
1329     my ($isbn) = @_;
1330
1331     return unless $isbn;
1332
1333     my @isbns;
1334
1335     push( @isbns, NormalizeISBN({ isbn => $isbn }) );
1336     push( @isbns, NormalizeISBN({ isbn => $isbn, format => 'ISBN-10' }) );
1337     push( @isbns, NormalizeISBN({ isbn => $isbn, format => 'ISBN-13' }) );
1338     push( @isbns, NormalizeISBN({ isbn => $isbn, format => 'ISBN-10', strip_hyphens => 1 }) );
1339     push( @isbns, NormalizeISBN({ isbn => $isbn, format => 'ISBN-13', strip_hyphens => 1 }) );
1340
1341     # Strip out any "empty" strings from the array
1342     @isbns = grep { defined($_) && $_ =~ /\S/ } @isbns;
1343
1344     return wantarray ? @isbns : join( " | ", @isbns );
1345 }
1346
1347 =head2 GetVariationsOfISBNs
1348
1349   my @isbns = GetVariationsOfISBNs( @isbns );
1350
1351   Returns a list of variations of the given isbns in
1352   both ISBN-10 and ISBN-13 formats, with and without
1353   hyphens.
1354
1355   In a scalar context, the isbns are returned as a
1356   string delimited by ' | '.
1357
1358 =cut
1359
1360 sub GetVariationsOfISBNs {
1361     my (@isbns) = @_;
1362
1363     @isbns = map { GetVariationsOfISBN( $_ ) } @isbns;
1364
1365     return wantarray ? @isbns : join( " | ", @isbns );
1366 }
1367
1368 =head2 IsKohaFieldLinked
1369
1370     my $is_linked = IsKohaFieldLinked({
1371         kohafield => $kohafield,
1372         frameworkcode => $frameworkcode,
1373     });
1374
1375     Return 1 if the field is linked
1376
1377 =cut
1378
1379 sub IsKohaFieldLinked {
1380     my ( $params ) = @_;
1381     my $kohafield = $params->{kohafield};
1382     my $frameworkcode = $params->{frameworkcode} || '';
1383     my $dbh = C4::Context->dbh;
1384     my $is_linked = $dbh->selectcol_arrayref( q|
1385         SELECT COUNT(*)
1386         FROM marc_subfield_structure
1387         WHERE frameworkcode = ?
1388         AND kohafield = ?
1389     |,{}, $frameworkcode, $kohafield );
1390     return $is_linked->[0];
1391 }
1392
1393 1;
1394
1395 __END__
1396
1397 =head1 AUTHOR
1398
1399 Koha Team
1400
1401 =cut