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