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