C4/Koha.pm

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