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]);
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<$opac> If set to a true value, displays OPAC descriptions rather than normal ones when they exist.
1008
1009 =cut
1010
1011 sub GetAuthorisedValues {
1012     my ( $category, $opac ) = @_;
1013
1014     # Is this cached already?
1015     $opac = $opac ? 1 : 0;    # normalise to be safe
1016     my $branch_limit =
1017       C4::Context->userenv ? C4::Context->userenv->{"branch"} : "";
1018     my $cache_key =
1019       "AuthorisedValues-$category-$opac-$branch_limit";
1020     my $cache  = Koha::Cache->get_instance();
1021     my $result = $cache->get_from_cache($cache_key);
1022     return $result if $result;
1023
1024     my @results;
1025     my $dbh      = C4::Context->dbh;
1026     my $query = qq{
1027         SELECT *
1028         FROM authorised_values
1029     };
1030     $query .= qq{
1031           LEFT JOIN authorised_values_branches ON ( id = av_id )
1032     } if $branch_limit;
1033     my @where_strings;
1034     my @where_args;
1035     if($category) {
1036         push @where_strings, "category = ?";
1037         push @where_args, $category;
1038     }
1039     if($branch_limit) {
1040         push @where_strings, "( branchcode = ? OR branchcode IS NULL )";
1041         push @where_args, $branch_limit;
1042     }
1043     if(@where_strings > 0) {
1044         $query .= " WHERE " . join(" AND ", @where_strings);
1045     }
1046     $query .= " GROUP BY lib";
1047     $query .= ' ORDER BY category, ' . (
1048                 $opac ? 'COALESCE(lib_opac, lib)'
1049                       : 'lib, lib_opac'
1050               );
1051
1052     my $sth = $dbh->prepare($query);
1053
1054     $sth->execute( @where_args );
1055     while (my $data=$sth->fetchrow_hashref) {
1056         if ($opac && $data->{lib_opac}) {
1057             $data->{lib} = $data->{lib_opac};
1058         }
1059         push @results, $data;
1060     }
1061     $sth->finish;
1062
1063     $cache->set_in_cache( $cache_key, \@results, { deepcopy => 1, expiry => 5 } );
1064     return \@results;
1065 }
1066
1067 =head2 GetAuthorisedValueCategories
1068
1069   $auth_categories = GetAuthorisedValueCategories();
1070
1071 Return an arrayref of all of the available authorised
1072 value categories.
1073
1074 =cut
1075
1076 sub GetAuthorisedValueCategories {
1077     my $dbh = C4::Context->dbh;
1078     my $sth = $dbh->prepare("SELECT DISTINCT category FROM authorised_values ORDER BY category");
1079     $sth->execute;
1080     my @results;
1081     while (defined (my $category  = $sth->fetchrow_array) ) {
1082         push @results, $category;
1083     }
1084     return \@results;
1085 }
1086
1087 =head2 GetAuthorisedValueByCode
1088
1089 $authorised_value = GetAuthorisedValueByCode( $category, $authvalcode, $opac );
1090
1091 Return the lib attribute from authorised_values from the row identified
1092 by the passed category and code
1093
1094 =cut
1095
1096 sub GetAuthorisedValueByCode {
1097     my ( $category, $authvalcode, $opac ) = @_;
1098
1099     my $field = $opac ? 'lib_opac' : 'lib';
1100     my $dbh = C4::Context->dbh;
1101     my $sth = $dbh->prepare("SELECT $field FROM authorised_values WHERE category=? AND authorised_value =?");
1102     $sth->execute( $category, $authvalcode );
1103     while ( my $data = $sth->fetchrow_hashref ) {
1104         return $data->{ $field };
1105     }
1106 }
1107
1108 =head2 GetKohaAuthorisedValues
1109
1110 Takes $kohafield, $fwcode as parameters.
1111
1112 If $opac parameter is set to a true value, displays OPAC descriptions rather than normal ones when they exist.
1113
1114 Returns hashref of Code => description
1115
1116 Returns undef if no authorised value category is defined for the kohafield.
1117
1118 =cut
1119
1120 sub GetKohaAuthorisedValues {
1121   my ($kohafield,$fwcode,$opac) = @_;
1122   $fwcode='' unless $fwcode;
1123   my %values;
1124   my $dbh = C4::Context->dbh;
1125   my $avcode = GetAuthValCode($kohafield,$fwcode);
1126   if ($avcode) {
1127         my $sth = $dbh->prepare("select authorised_value, lib, lib_opac from authorised_values where category=? ");
1128         $sth->execute($avcode);
1129         while ( my ($val, $lib, $lib_opac) = $sth->fetchrow_array ) {
1130                 $values{$val} = ($opac && $lib_opac) ? $lib_opac : $lib;
1131         }
1132         return \%values;
1133   } else {
1134         return;
1135   }
1136 }
1137
1138 =head2 GetKohaAuthorisedValuesFromField
1139
1140 Takes $field, $subfield, $fwcode as parameters.
1141
1142 If $opac parameter is set to a true value, displays OPAC descriptions rather than normal ones when they exist.
1143 $subfield can be undefined
1144
1145 Returns hashref of Code => description
1146
1147 Returns undef if no authorised value category is defined for the given field and subfield
1148
1149 =cut
1150
1151 sub GetKohaAuthorisedValuesFromField {
1152   my ($field, $subfield, $fwcode,$opac) = @_;
1153   $fwcode='' unless $fwcode;
1154   my %values;
1155   my $dbh = C4::Context->dbh;
1156   my $avcode = GetAuthValCodeFromField($field, $subfield, $fwcode);
1157   if ($avcode) {
1158         my $sth = $dbh->prepare("select authorised_value, lib, lib_opac from authorised_values where category=? ");
1159         $sth->execute($avcode);
1160         while ( my ($val, $lib, $lib_opac) = $sth->fetchrow_array ) {
1161                 $values{$val} = ($opac && $lib_opac) ? $lib_opac : $lib;
1162         }
1163         return \%values;
1164   } else {
1165         return;
1166   }
1167 }
1168
1169 =head2 GetKohaAuthorisedValuesMapping
1170
1171 Takes a hash as a parameter. The interface key indicates the
1172 description to use in the mapping.
1173
1174 Returns hashref of:
1175  "{kohafield},{frameworkcode},{authorised_value}" => "{description}"
1176 for all the kohafields, frameworkcodes, and authorised values.
1177
1178 Returns undef if nothing is found.
1179
1180 =cut
1181
1182 sub GetKohaAuthorisedValuesMapping {
1183     my ($parameter) = @_;
1184     my $interface = $parameter->{'interface'} // '';
1185
1186     my $query_mapping = q{
1187 SELECT TA.kohafield,TA.authorised_value AS category,
1188        TA.frameworkcode,TB.authorised_value,
1189        IF(TB.lib_opac>'',TB.lib_opac,TB.lib) AS OPAC,
1190        TB.lib AS Intranet,TB.lib_opac
1191 FROM marc_subfield_structure AS TA JOIN
1192      authorised_values as TB ON
1193      TA.authorised_value=TB.category
1194 WHERE TA.kohafield>'' AND TA.authorised_value>'';
1195     };
1196     my $dbh = C4::Context->dbh;
1197     my $sth = $dbh->prepare($query_mapping);
1198     $sth->execute();
1199     my $avmapping;
1200     if ($interface eq 'opac') {
1201         while (my $row = $sth->fetchrow_hashref) {
1202             $avmapping->{$row->{kohafield}.",".$row->{frameworkcode}.",".$row->{authorised_value}} = $row->{OPAC};
1203         }
1204     }
1205     else {
1206         while (my $row = $sth->fetchrow_hashref) {
1207             $avmapping->{$row->{kohafield}.",".$row->{frameworkcode}.",".$row->{authorised_value}} = $row->{Intranet};
1208         }
1209     }
1210     return $avmapping;
1211 }
1212
1213 =head2 xml_escape
1214
1215   my $escaped_string = C4::Koha::xml_escape($string);
1216
1217 Convert &, <, >, ', and " in a string to XML entities
1218
1219 =cut
1220
1221 sub xml_escape {
1222     my $str = shift;
1223     return '' unless defined $str;
1224     $str =~ s/&/&amp;/g;
1225     $str =~ s/</&lt;/g;
1226     $str =~ s/>/&gt;/g;
1227     $str =~ s/'/&apos;/g;
1228     $str =~ s/"/&quot;/g;
1229     return $str;
1230 }
1231
1232 =head2 GetKohaAuthorisedValueLib
1233
1234 Takes $category, $authorised_value as parameters.
1235
1236 If $opac parameter is set to a true value, displays OPAC descriptions rather than normal ones when they exist.
1237
1238 Returns authorised value description
1239
1240 =cut
1241
1242 sub GetKohaAuthorisedValueLib {
1243   my ($category,$authorised_value,$opac) = @_;
1244   my $value;
1245   my $dbh = C4::Context->dbh;
1246   my $sth = $dbh->prepare("select lib, lib_opac from authorised_values where category=? and authorised_value=?");
1247   $sth->execute($category,$authorised_value);
1248   my $data = $sth->fetchrow_hashref;
1249   $value = ($opac && $$data{'lib_opac'}) ? $$data{'lib_opac'} : $$data{'lib'};
1250   return $value;
1251 }
1252
1253 =head2 display_marc_indicators
1254
1255   my $display_form = C4::Koha::display_marc_indicators($field);
1256
1257 C<$field> is a MARC::Field object
1258
1259 Generate a display form of the indicators of a variable
1260 MARC field, replacing any blanks with '#'.
1261
1262 =cut
1263
1264 sub display_marc_indicators {
1265     my $field = shift;
1266     my $indicators = '';
1267     if ($field && $field->tag() >= 10) {
1268         $indicators = $field->indicator(1) . $field->indicator(2);
1269         $indicators =~ s/ /#/g;
1270     }
1271     return $indicators;
1272 }
1273
1274 sub GetNormalizedUPC {
1275     my ($marcrecord,$marcflavour) = @_;
1276
1277     return unless $marcrecord;
1278     if ($marcflavour eq 'UNIMARC') {
1279         my @fields = $marcrecord->field('072');
1280         foreach my $field (@fields) {
1281             my $upc = _normalize_match_point($field->subfield('a'));
1282             if ($upc) {
1283                 return $upc;
1284             }
1285         }
1286
1287     }
1288     else { # assume marc21 if not unimarc
1289         my @fields = $marcrecord->field('024');
1290         foreach my $field (@fields) {
1291             my $indicator = $field->indicator(1);
1292             my $upc = _normalize_match_point($field->subfield('a'));
1293             if ($upc && $indicator == 1 ) {
1294                 return $upc;
1295             }
1296         }
1297     }
1298 }
1299
1300 # Normalizes and returns the first valid ISBN found in the record
1301 # ISBN13 are converted into ISBN10. This is required to get some book cover images.
1302 sub GetNormalizedISBN {
1303     my ($isbn,$marcrecord,$marcflavour) = @_;
1304     if ($isbn) {
1305         # Koha attempts to store multiple ISBNs in biblioitems.isbn, separated by " | "
1306         # anything after " | " should be removed, along with the delimiter
1307         ($isbn) = split(/\|/, $isbn );
1308         return _isbn_cleanup($isbn);
1309     }
1310
1311     return unless $marcrecord;
1312
1313     if ($marcflavour eq 'UNIMARC') {
1314         my @fields = $marcrecord->field('010');
1315         foreach my $field (@fields) {
1316             my $isbn = $field->subfield('a');
1317             if ($isbn) {
1318                 return _isbn_cleanup($isbn);
1319             }
1320         }
1321     }
1322     else { # assume marc21 if not unimarc
1323         my @fields = $marcrecord->field('020');
1324         foreach my $field (@fields) {
1325             $isbn = $field->subfield('a');
1326             if ($isbn) {
1327                 return _isbn_cleanup($isbn);
1328             }
1329         }
1330     }
1331 }
1332
1333 sub GetNormalizedEAN {
1334     my ($marcrecord,$marcflavour) = @_;
1335
1336     return unless $marcrecord;
1337
1338     if ($marcflavour eq 'UNIMARC') {
1339         my @fields = $marcrecord->field('073');
1340         foreach my $field (@fields) {
1341             my $ean = _normalize_match_point($field->subfield('a'));
1342             if ( $ean ) {
1343                 return $ean;
1344             }
1345         }
1346     }
1347     else { # assume marc21 if not unimarc
1348         my @fields = $marcrecord->field('024');
1349         foreach my $field (@fields) {
1350             my $indicator = $field->indicator(1);
1351             my $ean = _normalize_match_point($field->subfield('a'));
1352             if ( $ean && $indicator == 3  ) {
1353                 return $ean;
1354             }
1355         }
1356     }
1357 }
1358
1359 sub GetNormalizedOCLCNumber {
1360     my ($marcrecord,$marcflavour) = @_;
1361     return unless $marcrecord;
1362
1363     if ($marcflavour ne 'UNIMARC' ) {
1364         my @fields = $marcrecord->field('035');
1365         foreach my $field (@fields) {
1366             my $oclc = $field->subfield('a');
1367             if ($oclc =~ /OCoLC/) {
1368                 $oclc =~ s/\(OCoLC\)//;
1369                 return $oclc;
1370             }
1371         }
1372     } else {
1373         # TODO for UNIMARC
1374     }
1375     return
1376 }
1377
1378 sub GetAuthvalueDropbox {
1379     my ( $authcat, $default ) = @_;
1380     my $branch_limit = C4::Context->userenv ? C4::Context->userenv->{"branch"} : "";
1381     my $dbh = C4::Context->dbh;
1382
1383     my $query = qq{
1384         SELECT *
1385         FROM authorised_values
1386     };
1387     $query .= qq{
1388           LEFT JOIN authorised_values_branches ON ( id = av_id )
1389     } if $branch_limit;
1390     $query .= qq{
1391         WHERE category = ?
1392     };
1393     $query .= " AND ( branchcode = ? OR branchcode IS NULL )" if $branch_limit;
1394     $query .= " GROUP BY lib ORDER BY category, lib, lib_opac";
1395     my $sth = $dbh->prepare($query);
1396     $sth->execute( $authcat, $branch_limit ? $branch_limit : () );
1397
1398
1399     my $option_list = [];
1400     my @authorised_values = ( q{} );
1401     while (my $av = $sth->fetchrow_hashref) {
1402         push @{$option_list}, {
1403             value => $av->{authorised_value},
1404             label => $av->{lib},
1405             default => ($default eq $av->{authorised_value}),
1406         };
1407     }
1408
1409     if ( @{$option_list} ) {
1410         return $option_list;
1411     }
1412     return;
1413 }
1414
1415
1416 =head2 GetDailyQuote($opts)
1417
1418 Takes a hashref of options
1419
1420 Currently supported options are:
1421
1422 'id'        An exact quote id
1423 'random'    Select a random quote
1424 noop        When no option is passed in, this sub will return the quote timestamped for the current day
1425
1426 The function returns an anonymous hash following this format:
1427
1428         {
1429           'source' => 'source-of-quote',
1430           'timestamp' => 'timestamp-value',
1431           'text' => 'text-of-quote',
1432           'id' => 'quote-id'
1433         };
1434
1435 =cut
1436
1437 # This is definitely a candidate for some sort of caching once we finally settle caching/persistence issues...
1438 # at least for default option
1439
1440 sub GetDailyQuote {
1441     my %opts = @_;
1442     my $dbh = C4::Context->dbh;
1443     my $query = '';
1444     my $sth = undef;
1445     my $quote = undef;
1446     if ($opts{'id'}) {
1447         $query = 'SELECT * FROM quotes WHERE id = ?';
1448         $sth = $dbh->prepare($query);
1449         $sth->execute($opts{'id'});
1450         $quote = $sth->fetchrow_hashref();
1451     }
1452     elsif ($opts{'random'}) {
1453         # Fall through... we also return a random quote as a catch-all if all else fails
1454     }
1455     else {
1456         $query = 'SELECT * FROM quotes WHERE timestamp LIKE CONCAT(CURRENT_DATE,\'%\') ORDER BY timestamp DESC LIMIT 0,1';
1457         $sth = $dbh->prepare($query);
1458         $sth->execute();
1459         $quote = $sth->fetchrow_hashref();
1460     }
1461     unless ($quote) {        # if there are not matches, choose a random quote
1462         # get a list of all available quote ids
1463         $sth = C4::Context->dbh->prepare('SELECT count(*) FROM quotes;');
1464         $sth->execute;
1465         my $range = ($sth->fetchrow_array)[0];
1466         # chose a random id within that range if there is more than one quote
1467         my $offset = int(rand($range));
1468         # grab it
1469         $query = 'SELECT * FROM quotes ORDER BY id LIMIT 1 OFFSET ?';
1470         $sth = C4::Context->dbh->prepare($query);
1471         # see http://www.perlmonks.org/?node_id=837422 for why
1472         # we're being verbose and using bind_param
1473         $sth->bind_param(1, $offset, SQL_INTEGER);
1474         $sth->execute();
1475         $quote = $sth->fetchrow_hashref();
1476         # update the timestamp for that quote
1477         $query = 'UPDATE quotes SET timestamp = ? WHERE id = ?';
1478         $sth = C4::Context->dbh->prepare($query);
1479         $sth->execute(
1480             DateTime::Format::MySQL->format_datetime( dt_from_string() ),
1481             $quote->{'id'}
1482         );
1483     }
1484     return $quote;
1485 }
1486
1487 sub _normalize_match_point {
1488     my $match_point = shift;
1489     (my $normalized_match_point) = $match_point =~ /([\d-]*[X]*)/;
1490     $normalized_match_point =~ s/-//g;
1491
1492     return $normalized_match_point;
1493 }
1494
1495 sub _isbn_cleanup {
1496     my ($isbn) = @_;
1497     return NormalizeISBN(
1498         {
1499             isbn          => $isbn,
1500             format        => 'ISBN-10',
1501             strip_hyphens => 1,
1502         }
1503     ) if $isbn;
1504 }
1505
1506 =head2 NormalizedISBN
1507
1508   my $isbns = NormalizedISBN({
1509     isbn => $isbn,
1510     strip_hyphens => [0,1],
1511     format => ['ISBN-10', 'ISBN-13']
1512   });
1513
1514   Returns an isbn validated by Business::ISBN.
1515   Optionally strips hyphens and/or forces the isbn
1516   to be of the specified format.
1517
1518   If the string cannot be validated as an isbn,
1519   it returns nothing.
1520
1521 =cut
1522
1523 sub NormalizeISBN {
1524     my ($params) = @_;
1525
1526     my $string        = $params->{isbn};
1527     my $strip_hyphens = $params->{strip_hyphens};
1528     my $format        = $params->{format};
1529
1530     return unless $string;
1531
1532     my $isbn = Business::ISBN->new($string);
1533
1534     if ( $isbn && $isbn->is_valid() ) {
1535
1536         if ( $format eq 'ISBN-10' ) {
1537             $isbn = $isbn->as_isbn10();
1538         }
1539         elsif ( $format eq 'ISBN-13' ) {
1540             $isbn = $isbn->as_isbn13();
1541         }
1542         return unless $isbn;
1543
1544         if ($strip_hyphens) {
1545             $string = $isbn->as_string( [] );
1546         } else {
1547             $string = $isbn->as_string();
1548         }
1549
1550         return $string;
1551     }
1552 }
1553
1554 =head2 GetVariationsOfISBN
1555
1556   my @isbns = GetVariationsOfISBN( $isbn );
1557
1558   Returns a list of variations of the given isbn in
1559   both ISBN-10 and ISBN-13 formats, with and without
1560   hyphens.
1561
1562   In a scalar context, the isbns are returned as a
1563   string delimited by ' | '.
1564
1565 =cut
1566
1567 sub GetVariationsOfISBN {
1568     my ($isbn) = @_;
1569
1570     return unless $isbn;
1571
1572     my @isbns;
1573
1574     push( @isbns, NormalizeISBN({ isbn => $isbn }) );
1575     push( @isbns, NormalizeISBN({ isbn => $isbn, format => 'ISBN-10' }) );
1576     push( @isbns, NormalizeISBN({ isbn => $isbn, format => 'ISBN-13' }) );
1577     push( @isbns, NormalizeISBN({ isbn => $isbn, format => 'ISBN-10', strip_hyphens => 1 }) );
1578     push( @isbns, NormalizeISBN({ isbn => $isbn, format => 'ISBN-13', strip_hyphens => 1 }) );
1579
1580     # Strip out any "empty" strings from the array
1581     @isbns = grep { defined($_) && $_ =~ /\S/ } @isbns;
1582
1583     return wantarray ? @isbns : join( " | ", @isbns );
1584 }
1585
1586 =head2 GetVariationsOfISBNs
1587
1588   my @isbns = GetVariationsOfISBNs( @isbns );
1589
1590   Returns a list of variations of the given isbns in
1591   both ISBN-10 and ISBN-13 formats, with and without
1592   hyphens.
1593
1594   In a scalar context, the isbns are returned as a
1595   string delimited by ' | '.
1596
1597 =cut
1598
1599 sub GetVariationsOfISBNs {
1600     my (@isbns) = @_;
1601
1602     @isbns = map { GetVariationsOfISBN( $_ ) } @isbns;
1603
1604     return wantarray ? @isbns : join( " | ", @isbns );
1605 }
1606
1607 =head2 IsKohaFieldLinked
1608
1609     my $is_linked = IsKohaFieldLinked({
1610         kohafield => $kohafield,
1611         frameworkcode => $frameworkcode,
1612     });
1613
1614     Return 1 if the field is linked
1615
1616 =cut
1617
1618 sub IsKohaFieldLinked {
1619     my ( $params ) = @_;
1620     my $kohafield = $params->{kohafield};
1621     my $frameworkcode = $params->{frameworkcode} || '';
1622     my $dbh = C4::Context->dbh;
1623     my $is_linked = $dbh->selectcol_arrayref( q|
1624         SELECT COUNT(*)
1625         FROM marc_subfield_structure
1626         WHERE frameworkcode = ?
1627         AND kohafield = ?
1628     |,{}, $frameworkcode, $kohafield );
1629     return $is_linked->[0];
1630 }
1631
1632 1;
1633
1634 __END__
1635
1636 =head1 AUTHOR
1637
1638 Koha Team
1639
1640 =cut