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