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