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 ( C4::Context->preference("singleBranchMode")
 760                 || Koha::Libraries->search->count == 1 )
 761             {
 762                 my $DisplayLibraryFacets = C4::Context->preference('DisplayLibraryFacets');
 763                 if (   $DisplayLibraryFacets eq 'both'
 764                     || $DisplayLibraryFacets eq 'holding' )
 765                 {
 766                     push(
 767                         @$facets,
 768                         {
 769                             idx   => 'holdingbranch',
 770                             label => 'HoldingLibrary',
 771                             tags  => [qw / 995c /],
 772                         }
 773                     );
 774                 }
 775
 776                 if (   $DisplayLibraryFacets eq 'both'
 777                     || $DisplayLibraryFacets eq 'home' )
 778                 {
 779                 push(
 780                     @$facets,
 781                     {
 782                         idx   => 'homebranch',
 783                         label => 'HomeLibrary',
 784                         tags  => [qw / 995b /],
 785                     }
 786                 );
 787                 }
 788             }
 789     }
 790     else {
 791         $facets = [
 792             {
 793                 idx   => 'su-to',
 794                 label => 'Topics',
 795                 tags  => [ qw/ 650a / ],
 796                 sep   => '--',
 797             },
 798             #        {
 799             #        idx   => 'su-na',
 800             #        label => 'People and Organizations',
 801             #        tags  => [ qw/ 600a 610a 611a / ],
 802             #        sep   => 'a',
 803             #        },
 804             {
 805                 idx   => 'su-geo',
 806                 label => 'Places',
 807                 tags  => [ qw/ 651a / ],
 808                 sep   => '--',
 809             },
 810             {
 811                 idx   => 'su-ut',
 812                 label => 'Titles',
 813                 tags  => [ qw/ 630a / ],
 814                 sep   => '--',
 815             },
 816             {
 817                 idx   => 'au',
 818                 label => 'Authors',
 819                 tags  => [ qw/ 100a 110a 700a / ],
 820                 sep   => ', ',
 821             },
 822             {
 823                 idx   => 'se',
 824                 label => 'Series',
 825                 tags  => [ qw/ 440a 490a / ],
 826                 sep   => ', ',
 827             },
 828             {
 829                 idx   => 'itype',
 830                 label => 'ItemTypes',
 831                 tags  => [ qw/ 952y 942c / ],
 832                 sep   => ', ',
 833             },
 834             {
 835                 idx => 'location',
 836                 label => 'Location',
 837                 tags => [ qw / 952c / ],
 838             },
 839             ];
 840
 841             unless ( C4::Context->preference("singleBranchMode")
 842                 || Koha::Libraries->search->count == 1 )
 843             {
 844                 my $DisplayLibraryFacets = C4::Context->preference('DisplayLibraryFacets');
 845                 if (   $DisplayLibraryFacets eq 'both'
 846                     || $DisplayLibraryFacets eq 'holding' )
 847                 {
 848                     push(
 849                         @$facets,
 850                         {
 851                             idx   => 'holdingbranch',
 852                             label => 'HoldingLibrary',
 853                             tags  => [qw / 952b /],
 854                         }
 855                     );
 856                 }
 857
 858                 if (   $DisplayLibraryFacets eq 'both'
 859                     || $DisplayLibraryFacets eq 'home' )
 860                 {
 861                 push(
 862                     @$facets,
 863                     {
 864                         idx   => 'homebranch',
 865                         label => 'HomeLibrary',
 866                         tags  => [qw / 952a /],
 867                     }
 868                 );
 869                 }
 870             }
 871     }
 872     return $facets;
 873 }
 874
 875 =head2 get_infos_of
 876
 877 Return a href where a key is associated to a href. You give a query,
 878 the name of the key among the fields returned by the query. If you
 879 also give as third argument the name of the value, the function
 880 returns a href of scalar. The optional 4th argument is an arrayref of
 881 items passed to the C<execute()> call. It is designed to bind
 882 parameters to any placeholders in your SQL.
 883
 884   my $query = '
 885 SELECT itemnumber,
 886        notforloan,
 887        barcode
 888   FROM items
 889 ';
 890
 891   # generic href of any information on the item, href of href.
 892   my $iteminfos_of = get_infos_of($query, 'itemnumber');
 893   print $iteminfos_of->{$itemnumber}{barcode};
 894
 895   # specific information, href of scalar
 896   my $barcode_of_item = get_infos_of($query, 'itemnumber', 'barcode');
 897   print $barcode_of_item->{$itemnumber};
 898
 899 =cut
 900
 901 sub get_infos_of {
 902     my ( $query, $key_name, $value_name, $bind_params ) = @_;
 903
 904     my $dbh = C4::Context->dbh;
 905
 906     my $sth = $dbh->prepare($query);
 907     $sth->execute( @$bind_params );
 908
 909     my %infos_of;
 910     while ( my $row = $sth->fetchrow_hashref ) {
 911         if ( defined $value_name ) {
 912             $infos_of{ $row->{$key_name} } = $row->{$value_name};
 913         }
 914         else {
 915             $infos_of{ $row->{$key_name} } = $row;
 916         }
 917     }
 918     $sth->finish;
 919
 920     return \%infos_of;
 921 }
 922
 923 =head2 get_notforloan_label_of
 924
 925   my $notforloan_label_of = get_notforloan_label_of();
 926
 927 Each authorised value of notforloan (information available in items and
 928 itemtypes) is link to a single label.
 929
 930 Returns a href where keys are authorised values and values are corresponding
 931 labels.
 932
 933   foreach my $authorised_value (keys %{$notforloan_label_of}) {
 934     printf(
 935         "authorised_value: %s => %s\n",
 936         $authorised_value,
 937         $notforloan_label_of->{$authorised_value}
 938     );
 939   }
 940
 941 =cut
 942
 943 # FIXME - why not use GetAuthorisedValues ??
 944 #
 945 sub get_notforloan_label_of {
 946     my $dbh = C4::Context->dbh;
 947
 948     my $query = '
 949 SELECT authorised_value
 950   FROM marc_subfield_structure
 951   WHERE kohafield = \'items.notforloan\'
 952   LIMIT 0, 1
 953 ';
 954     my $sth = $dbh->prepare($query);
 955     $sth->execute();
 956     my ($statuscode) = $sth->fetchrow_array();
 957
 958     $query = '
 959 SELECT lib,
 960        authorised_value
 961   FROM authorised_values
 962   WHERE category = ?
 963 ';
 964     $sth = $dbh->prepare($query);
 965     $sth->execute($statuscode);
 966     my %notforloan_label_of;
 967     while ( my $row = $sth->fetchrow_hashref ) {
 968         $notforloan_label_of{ $row->{authorised_value} } = $row->{lib};
 969     }
 970     $sth->finish;
 971
 972     return \%notforloan_label_of;
 973 }
 974
 975 =head2 GetAuthValCode
 976
 977   $authvalcode = GetAuthValCode($kohafield,$frameworkcode);
 978
 979 =cut
 980
 981 sub GetAuthValCode {
 982         my ($kohafield,$fwcode) = @_;
 983         my $dbh = C4::Context->dbh;
 984         $fwcode='' unless $fwcode;
 985         my $sth = $dbh->prepare('select authorised_value from marc_subfield_structure where kohafield=? and frameworkcode=?');
 986         $sth->execute($kohafield,$fwcode);
 987         my ($authvalcode) = $sth->fetchrow_array;
 988         return $authvalcode;
 989 }
 990
 991 =head2 GetAuthValCodeFromField
 992
 993   $authvalcode = GetAuthValCodeFromField($field,$subfield,$frameworkcode);
 994
 995 C<$subfield> can be undefined
 996
 997 =cut
 998
 999 sub GetAuthValCodeFromField {
1000         my ($field,$subfield,$fwcode) = @_;
1001         my $dbh = C4::Context->dbh;
1002         $fwcode='' unless $fwcode;
1003         my $sth;
1004         if (defined $subfield) {
1005             $sth = $dbh->prepare('select authorised_value from marc_subfield_structure where tagfield=? and tagsubfield=? and frameworkcode=?');
1006             $sth->execute($field,$subfield,$fwcode);
1007         } else {
1008             $sth = $dbh->prepare('select authorised_value from marc_tag_structure where tagfield=? and frameworkcode=?');
1009             $sth->execute($field,$fwcode);
1010         }
1011         my ($authvalcode) = $sth->fetchrow_array;
1012         return $authvalcode;
1013 }
1014
1015 =head2 GetAuthorisedValues
1016
1017   $authvalues = GetAuthorisedValues([$category], [$selected]);
1018
1019 This function returns all authorised values from the'authorised_value' table in a reference to array of hashrefs.
1020
1021 C<$category> returns authorised values for just one category (optional).
1022
1023 C<$selected> adds a "selected => 1" entry to the hash if the
1024 authorised_value matches it. B<NOTE:> this feature should be considered
1025 deprecated as it may be removed in the future.
1026
1027 C<$opac> If set to a true value, displays OPAC descriptions rather than normal ones when they exist.
1028
1029 =cut
1030
1031 sub GetAuthorisedValues {
1032     my ( $category, $selected, $opac ) = @_;
1033
1034     # TODO: the "selected" feature should be replaced by a utility function
1035     # somewhere else, it doesn't belong in here. For starters it makes
1036     # caching much more complicated. Or just let the UI logic handle it, it's
1037     # what it's for.
1038
1039     # Is this cached already?
1040     $opac = $opac ? 1 : 0;    # normalise to be safe
1041     my $branch_limit =
1042       C4::Context->userenv ? C4::Context->userenv->{"branch"} : "";
1043     my $selected_key = defined($selected) ? $selected : '';
1044     my $cache_key =
1045       "AuthorisedValues-$category-$selected_key-$opac-$branch_limit";
1046     my $cache  = Koha::Cache->get_instance();
1047     my $result = $cache->get_from_cache($cache_key);
1048     return $result if $result;
1049
1050     my @results;
1051     my $dbh      = C4::Context->dbh;
1052     my $query = qq{
1053         SELECT *
1054         FROM authorised_values
1055     };
1056     $query .= qq{
1057           LEFT JOIN authorised_values_branches ON ( id = av_id )
1058     } if $branch_limit;
1059     my @where_strings;
1060     my @where_args;
1061     if($category) {
1062         push @where_strings, "category = ?";
1063         push @where_args, $category;
1064     }
1065     if($branch_limit) {
1066         push @where_strings, "( branchcode = ? OR branchcode IS NULL )";
1067         push @where_args, $branch_limit;
1068     }
1069     if(@where_strings > 0) {
1070         $query .= " WHERE " . join(" AND ", @where_strings);
1071     }
1072     $query .= " GROUP BY lib";
1073     $query .= ' ORDER BY category, ' . (
1074                 $opac ? 'COALESCE(lib_opac, lib)'
1075                       : 'lib, lib_opac'
1076               );
1077
1078     my $sth = $dbh->prepare($query);
1079
1080     $sth->execute( @where_args );
1081     while (my $data=$sth->fetchrow_hashref) {
1082         if ( defined $selected and $selected eq $data->{authorised_value} ) {
1083             $data->{selected} = 1;
1084         }
1085         else {
1086             $data->{selected} = 0;
1087         }
1088
1089         if ($opac && $data->{lib_opac}) {
1090             $data->{lib} = $data->{lib_opac};
1091         }
1092         push @results, $data;
1093     }
1094     $sth->finish;
1095
1096     # We can't cache for long because of that "selected" thing which
1097     # makes it impossible to clear the cache without iterating through every
1098     # value, which sucks. This'll cover this request, and not a whole lot more.
1099     $cache->set_in_cache( $cache_key, \@results, { deepcopy => 1, expiry => 5 } );
1100     return \@results;
1101 }
1102
1103 =head2 GetAuthorisedValueCategories
1104
1105   $auth_categories = GetAuthorisedValueCategories();
1106
1107 Return an arrayref of all of the available authorised
1108 value categories.
1109
1110 =cut
1111
1112 sub GetAuthorisedValueCategories {
1113     my $dbh = C4::Context->dbh;
1114     my $sth = $dbh->prepare("SELECT DISTINCT category FROM authorised_values ORDER BY category");
1115     $sth->execute;
1116     my @results;
1117     while (defined (my $category  = $sth->fetchrow_array) ) {
1118         push @results, $category;
1119     }
1120     return \@results;
1121 }
1122
1123 =head2 IsAuthorisedValueCategory
1124
1125     $is_auth_val_category = IsAuthorisedValueCategory($category);
1126
1127 Returns whether a given category name is a valid one
1128
1129 =cut
1130
1131 sub IsAuthorisedValueCategory {
1132     my $category = shift;
1133     my $query = '
1134         SELECT category
1135         FROM authorised_values
1136         WHERE category=?
1137         LIMIT 1
1138     ';
1139     my $sth = C4::Context->dbh->prepare($query);
1140     $sth->execute($category);
1141     $sth->fetchrow ? return 1
1142                    : return 0;
1143 }
1144
1145 =head2 GetAuthorisedValueByCode
1146
1147 $authorised_value = GetAuthorisedValueByCode( $category, $authvalcode, $opac );
1148
1149 Return the lib attribute from authorised_values from the row identified
1150 by the passed category and code
1151
1152 =cut
1153
1154 sub GetAuthorisedValueByCode {
1155     my ( $category, $authvalcode, $opac ) = @_;
1156
1157     my $field = $opac ? 'lib_opac' : 'lib';
1158     my $dbh = C4::Context->dbh;
1159     my $sth = $dbh->prepare("SELECT $field FROM authorised_values WHERE category=? AND authorised_value =?");
1160     $sth->execute( $category, $authvalcode );
1161     while ( my $data = $sth->fetchrow_hashref ) {
1162         return $data->{ $field };
1163     }
1164 }
1165
1166 =head2 GetKohaAuthorisedValues
1167
1168 Takes $kohafield, $fwcode as parameters.
1169
1170 If $opac parameter is set to a true value, displays OPAC descriptions rather than normal ones when they exist.
1171
1172 Returns hashref of Code => description
1173
1174 Returns undef if no authorised value category is defined for the kohafield.
1175
1176 =cut
1177
1178 sub GetKohaAuthorisedValues {
1179   my ($kohafield,$fwcode,$opac) = @_;
1180   $fwcode='' unless $fwcode;
1181   my %values;
1182   my $dbh = C4::Context->dbh;
1183   my $avcode = GetAuthValCode($kohafield,$fwcode);
1184   if ($avcode) {
1185         my $sth = $dbh->prepare("select authorised_value, lib, lib_opac from authorised_values where category=? ");
1186         $sth->execute($avcode);
1187         while ( my ($val, $lib, $lib_opac) = $sth->fetchrow_array ) {
1188                 $values{$val} = ($opac && $lib_opac) ? $lib_opac : $lib;
1189         }
1190         return \%values;
1191   } else {
1192         return;
1193   }
1194 }
1195
1196 =head2 GetKohaAuthorisedValuesFromField
1197
1198 Takes $field, $subfield, $fwcode as parameters.
1199
1200 If $opac parameter is set to a true value, displays OPAC descriptions rather than normal ones when they exist.
1201 $subfield can be undefined
1202
1203 Returns hashref of Code => description
1204
1205 Returns undef if no authorised value category is defined for the given field and subfield
1206
1207 =cut
1208
1209 sub GetKohaAuthorisedValuesFromField {
1210   my ($field, $subfield, $fwcode,$opac) = @_;
1211   $fwcode='' unless $fwcode;
1212   my %values;
1213   my $dbh = C4::Context->dbh;
1214   my $avcode = GetAuthValCodeFromField($field, $subfield, $fwcode);
1215   if ($avcode) {
1216         my $sth = $dbh->prepare("select authorised_value, lib, lib_opac from authorised_values where category=? ");
1217         $sth->execute($avcode);
1218         while ( my ($val, $lib, $lib_opac) = $sth->fetchrow_array ) {
1219                 $values{$val} = ($opac && $lib_opac) ? $lib_opac : $lib;
1220         }
1221         return \%values;
1222   } else {
1223         return;
1224   }
1225 }
1226
1227 =head2 GetKohaAuthorisedValuesMapping
1228
1229 Takes a hash as a parameter. The interface key indicates the
1230 description to use in the mapping.
1231
1232 Returns hashref of:
1233  "{kohafield},{frameworkcode},{authorised_value}" => "{description}"
1234 for all the kohafields, frameworkcodes, and authorised values.
1235
1236 Returns undef if nothing is found.
1237
1238 =cut
1239
1240 sub GetKohaAuthorisedValuesMapping {
1241     my ($parameter) = @_;
1242     my $interface = $parameter->{'interface'} // '';
1243
1244     my $query_mapping = q{
1245 SELECT TA.kohafield,TA.authorised_value AS category,
1246        TA.frameworkcode,TB.authorised_value,
1247        IF(TB.lib_opac>'',TB.lib_opac,TB.lib) AS OPAC,
1248        TB.lib AS Intranet,TB.lib_opac
1249 FROM marc_subfield_structure AS TA JOIN
1250      authorised_values as TB ON
1251      TA.authorised_value=TB.category
1252 WHERE TA.kohafield>'' AND TA.authorised_value>'';
1253     };
1254     my $dbh = C4::Context->dbh;
1255     my $sth = $dbh->prepare($query_mapping);
1256     $sth->execute();
1257     my $avmapping;
1258     if ($interface eq 'opac') {
1259         while (my $row = $sth->fetchrow_hashref) {
1260             $avmapping->{$row->{kohafield}.",".$row->{frameworkcode}.",".$row->{authorised_value}} = $row->{OPAC};
1261         }
1262     }
1263     else {
1264         while (my $row = $sth->fetchrow_hashref) {
1265             $avmapping->{$row->{kohafield}.",".$row->{frameworkcode}.",".$row->{authorised_value}} = $row->{Intranet};
1266         }
1267     }
1268     return $avmapping;
1269 }
1270
1271 =head2 xml_escape
1272
1273   my $escaped_string = C4::Koha::xml_escape($string);
1274
1275 Convert &, <, >, ', and " in a string to XML entities
1276
1277 =cut
1278
1279 sub xml_escape {
1280     my $str = shift;
1281     return '' unless defined $str;
1282     $str =~ s/&/&amp;/g;
1283     $str =~ s/</&lt;/g;
1284     $str =~ s/>/&gt;/g;
1285     $str =~ s/'/&apos;/g;
1286     $str =~ s/"/&quot;/g;
1287     return $str;
1288 }
1289
1290 =head2 GetKohaAuthorisedValueLib
1291
1292 Takes $category, $authorised_value as parameters.
1293
1294 If $opac parameter is set to a true value, displays OPAC descriptions rather than normal ones when they exist.
1295
1296 Returns authorised value description
1297
1298 =cut
1299
1300 sub GetKohaAuthorisedValueLib {
1301   my ($category,$authorised_value,$opac) = @_;
1302   my $value;
1303   my $dbh = C4::Context->dbh;
1304   my $sth = $dbh->prepare("select lib, lib_opac from authorised_values where category=? and authorised_value=?");
1305   $sth->execute($category,$authorised_value);
1306   my $data = $sth->fetchrow_hashref;
1307   $value = ($opac && $$data{'lib_opac'}) ? $$data{'lib_opac'} : $$data{'lib'};
1308   return $value;
1309 }
1310
1311 =head2 display_marc_indicators
1312
1313   my $display_form = C4::Koha::display_marc_indicators($field);
1314
1315 C<$field> is a MARC::Field object
1316
1317 Generate a display form of the indicators of a variable
1318 MARC field, replacing any blanks with '#'.
1319
1320 =cut
1321
1322 sub display_marc_indicators {
1323     my $field = shift;
1324     my $indicators = '';
1325     if ($field && $field->tag() >= 10) {
1326         $indicators = $field->indicator(1) . $field->indicator(2);
1327         $indicators =~ s/ /#/g;
1328     }
1329     return $indicators;
1330 }
1331
1332 sub GetNormalizedUPC {
1333     my ($marcrecord,$marcflavour) = @_;
1334
1335     return unless $marcrecord;
1336     if ($marcflavour eq 'UNIMARC') {
1337         my @fields = $marcrecord->field('072');
1338         foreach my $field (@fields) {
1339             my $upc = _normalize_match_point($field->subfield('a'));
1340             if ($upc) {
1341                 return $upc;
1342             }
1343         }
1344
1345     }
1346     else { # assume marc21 if not unimarc
1347         my @fields = $marcrecord->field('024');
1348         foreach my $field (@fields) {
1349             my $indicator = $field->indicator(1);
1350             my $upc = _normalize_match_point($field->subfield('a'));
1351             if ($upc && $indicator == 1 ) {
1352                 return $upc;
1353             }
1354         }
1355     }
1356 }
1357
1358 # Normalizes and returns the first valid ISBN found in the record
1359 # ISBN13 are converted into ISBN10. This is required to get some book cover images.
1360 sub GetNormalizedISBN {
1361     my ($isbn,$marcrecord,$marcflavour) = @_;
1362     if ($isbn) {
1363         # Koha attempts to store multiple ISBNs in biblioitems.isbn, separated by " | "
1364         # anything after " | " should be removed, along with the delimiter
1365         ($isbn) = split(/\|/, $isbn );
1366         return _isbn_cleanup($isbn);
1367     }
1368
1369     return unless $marcrecord;
1370
1371     if ($marcflavour eq 'UNIMARC') {
1372         my @fields = $marcrecord->field('010');
1373         foreach my $field (@fields) {
1374             my $isbn = $field->subfield('a');
1375             if ($isbn) {
1376                 return _isbn_cleanup($isbn);
1377             }
1378         }
1379     }
1380     else { # assume marc21 if not unimarc
1381         my @fields = $marcrecord->field('020');
1382         foreach my $field (@fields) {
1383             $isbn = $field->subfield('a');
1384             if ($isbn) {
1385                 return _isbn_cleanup($isbn);
1386             }
1387         }
1388     }
1389 }
1390
1391 sub GetNormalizedEAN {
1392     my ($marcrecord,$marcflavour) = @_;
1393
1394     return unless $marcrecord;
1395
1396     if ($marcflavour eq 'UNIMARC') {
1397         my @fields = $marcrecord->field('073');
1398         foreach my $field (@fields) {
1399             my $ean = _normalize_match_point($field->subfield('a'));
1400             if ( $ean ) {
1401                 return $ean;
1402             }
1403         }
1404     }
1405     else { # assume marc21 if not unimarc
1406         my @fields = $marcrecord->field('024');
1407         foreach my $field (@fields) {
1408             my $indicator = $field->indicator(1);
1409             my $ean = _normalize_match_point($field->subfield('a'));
1410             if ( $ean && $indicator == 3  ) {
1411                 return $ean;
1412             }
1413         }
1414     }
1415 }
1416
1417 sub GetNormalizedOCLCNumber {
1418     my ($marcrecord,$marcflavour) = @_;
1419     return unless $marcrecord;
1420
1421     if ($marcflavour ne 'UNIMARC' ) {
1422         my @fields = $marcrecord->field('035');
1423         foreach my $field (@fields) {
1424             my $oclc = $field->subfield('a');
1425             if ($oclc =~ /OCoLC/) {
1426                 $oclc =~ s/\(OCoLC\)//;
1427                 return $oclc;
1428             }
1429         }
1430     } else {
1431         # TODO for UNIMARC
1432     }
1433     return
1434 }
1435
1436 sub GetAuthvalueDropbox {
1437     my ( $authcat, $default ) = @_;
1438     my $branch_limit = C4::Context->userenv ? C4::Context->userenv->{"branch"} : "";
1439     my $dbh = C4::Context->dbh;
1440
1441     my $query = qq{
1442         SELECT *
1443         FROM authorised_values
1444     };
1445     $query .= qq{
1446           LEFT JOIN authorised_values_branches ON ( id = av_id )
1447     } if $branch_limit;
1448     $query .= qq{
1449         WHERE category = ?
1450     };
1451     $query .= " AND ( branchcode = ? OR branchcode IS NULL )" if $branch_limit;
1452     $query .= " GROUP BY lib ORDER BY category, lib, lib_opac";
1453     my $sth = $dbh->prepare($query);
1454     $sth->execute( $authcat, $branch_limit ? $branch_limit : () );
1455
1456
1457     my $option_list = [];
1458     my @authorised_values = ( q{} );
1459     while (my $av = $sth->fetchrow_hashref) {
1460         push @{$option_list}, {
1461             value => $av->{authorised_value},
1462             label => $av->{lib},
1463             default => ($default eq $av->{authorised_value}),
1464         };
1465     }
1466
1467     if ( @{$option_list} ) {
1468         return $option_list;
1469     }
1470     return;
1471 }
1472
1473
1474 =head2 GetDailyQuote($opts)
1475
1476 Takes a hashref of options
1477
1478 Currently supported options are:
1479
1480 'id'        An exact quote id
1481 'random'    Select a random quote
1482 noop        When no option is passed in, this sub will return the quote timestamped for the current day
1483
1484 The function returns an anonymous hash following this format:
1485
1486         {
1487           'source' => 'source-of-quote',
1488           'timestamp' => 'timestamp-value',
1489           'text' => 'text-of-quote',
1490           'id' => 'quote-id'
1491         };
1492
1493 =cut
1494
1495 # This is definitely a candidate for some sort of caching once we finally settle caching/persistence issues...
1496 # at least for default option
1497
1498 sub GetDailyQuote {
1499     my %opts = @_;
1500     my $dbh = C4::Context->dbh;
1501     my $query = '';
1502     my $sth = undef;
1503     my $quote = undef;
1504     if ($opts{'id'}) {
1505         $query = 'SELECT * FROM quotes WHERE id = ?';
1506         $sth = $dbh->prepare($query);
1507         $sth->execute($opts{'id'});
1508         $quote = $sth->fetchrow_hashref();
1509     }
1510     elsif ($opts{'random'}) {
1511         # Fall through... we also return a random quote as a catch-all if all else fails
1512     }
1513     else {
1514         $query = 'SELECT * FROM quotes WHERE timestamp LIKE CONCAT(CURRENT_DATE,\'%\') ORDER BY timestamp DESC LIMIT 0,1';
1515         $sth = $dbh->prepare($query);
1516         $sth->execute();
1517         $quote = $sth->fetchrow_hashref();
1518     }
1519     unless ($quote) {        # if there are not matches, choose a random quote
1520         # get a list of all available quote ids
1521         $sth = C4::Context->dbh->prepare('SELECT count(*) FROM quotes;');
1522         $sth->execute;
1523         my $range = ($sth->fetchrow_array)[0];
1524         # chose a random id within that range if there is more than one quote
1525         my $offset = int(rand($range));
1526         # grab it
1527         $query = 'SELECT * FROM quotes ORDER BY id LIMIT 1 OFFSET ?';
1528         $sth = C4::Context->dbh->prepare($query);
1529         # see http://www.perlmonks.org/?node_id=837422 for why
1530         # we're being verbose and using bind_param
1531         $sth->bind_param(1, $offset, SQL_INTEGER);
1532         $sth->execute();
1533         $quote = $sth->fetchrow_hashref();
1534         # update the timestamp for that quote
1535         $query = 'UPDATE quotes SET timestamp = ? WHERE id = ?';
1536         $sth = C4::Context->dbh->prepare($query);
1537         $sth->execute(
1538             DateTime::Format::MySQL->format_datetime( dt_from_string() ),
1539             $quote->{'id'}
1540         );
1541     }
1542     return $quote;
1543 }
1544
1545 sub _normalize_match_point {
1546     my $match_point = shift;
1547     (my $normalized_match_point) = $match_point =~ /([\d-]*[X]*)/;
1548     $normalized_match_point =~ s/-//g;
1549
1550     return $normalized_match_point;
1551 }
1552
1553 sub _isbn_cleanup {
1554     my ($isbn) = @_;
1555     return NormalizeISBN(
1556         {
1557             isbn          => $isbn,
1558             format        => 'ISBN-10',
1559             strip_hyphens => 1,
1560         }
1561     ) if $isbn;
1562 }
1563
1564 =head2 NormalizedISBN
1565
1566   my $isbns = NormalizedISBN({
1567     isbn => $isbn,
1568     strip_hyphens => [0,1],
1569     format => ['ISBN-10', 'ISBN-13']
1570   });
1571
1572   Returns an isbn validated by Business::ISBN.
1573   Optionally strips hyphens and/or forces the isbn
1574   to be of the specified format.
1575
1576   If the string cannot be validated as an isbn,
1577   it returns nothing.
1578
1579 =cut
1580
1581 sub NormalizeISBN {
1582     my ($params) = @_;
1583
1584     my $string        = $params->{isbn};
1585     my $strip_hyphens = $params->{strip_hyphens};
1586     my $format        = $params->{format};
1587
1588     return unless $string;
1589
1590     my $isbn = Business::ISBN->new($string);
1591
1592     if ( $isbn && $isbn->is_valid() ) {
1593
1594         if ( $format eq 'ISBN-10' ) {
1595             $isbn = $isbn->as_isbn10();
1596         }
1597         elsif ( $format eq 'ISBN-13' ) {
1598             $isbn = $isbn->as_isbn13();
1599         }
1600         return unless $isbn;
1601
1602         if ($strip_hyphens) {
1603             $string = $isbn->as_string( [] );
1604         } else {
1605             $string = $isbn->as_string();
1606         }
1607
1608         return $string;
1609     }
1610 }
1611
1612 =head2 GetVariationsOfISBN
1613
1614   my @isbns = GetVariationsOfISBN( $isbn );
1615
1616   Returns a list of variations of the given isbn in
1617   both ISBN-10 and ISBN-13 formats, with and without
1618   hyphens.
1619
1620   In a scalar context, the isbns are returned as a
1621   string delimited by ' | '.
1622
1623 =cut
1624
1625 sub GetVariationsOfISBN {
1626     my ($isbn) = @_;
1627
1628     return unless $isbn;
1629
1630     my @isbns;
1631
1632     push( @isbns, NormalizeISBN({ isbn => $isbn }) );
1633     push( @isbns, NormalizeISBN({ isbn => $isbn, format => 'ISBN-10' }) );
1634     push( @isbns, NormalizeISBN({ isbn => $isbn, format => 'ISBN-13' }) );
1635     push( @isbns, NormalizeISBN({ isbn => $isbn, format => 'ISBN-10', strip_hyphens => 1 }) );
1636     push( @isbns, NormalizeISBN({ isbn => $isbn, format => 'ISBN-13', strip_hyphens => 1 }) );
1637
1638     # Strip out any "empty" strings from the array
1639     @isbns = grep { defined($_) && $_ =~ /\S/ } @isbns;
1640
1641     return wantarray ? @isbns : join( " | ", @isbns );
1642 }
1643
1644 =head2 GetVariationsOfISBNs
1645
1646   my @isbns = GetVariationsOfISBNs( @isbns );
1647
1648   Returns a list of variations of the given isbns in
1649   both ISBN-10 and ISBN-13 formats, with and without
1650   hyphens.
1651
1652   In a scalar context, the isbns are returned as a
1653   string delimited by ' | '.
1654
1655 =cut
1656
1657 sub GetVariationsOfISBNs {
1658     my (@isbns) = @_;
1659
1660     @isbns = map { GetVariationsOfISBN( $_ ) } @isbns;
1661
1662     return wantarray ? @isbns : join( " | ", @isbns );
1663 }
1664
1665 =head2 IsKohaFieldLinked
1666
1667     my $is_linked = IsKohaFieldLinked({
1668         kohafield => $kohafield,
1669         frameworkcode => $frameworkcode,
1670     });
1671
1672     Return 1 if the field is linked
1673
1674 =cut
1675
1676 sub IsKohaFieldLinked {
1677     my ( $params ) = @_;
1678     my $kohafield = $params->{kohafield};
1679     my $frameworkcode = $params->{frameworkcode} || '';
1680     my $dbh = C4::Context->dbh;
1681     my $is_linked = $dbh->selectcol_arrayref( q|
1682         SELECT COUNT(*)
1683         FROM marc_subfield_structure
1684         WHERE frameworkcode = ?
1685         AND kohafield = ?
1686     |,{}, $frameworkcode, $kohafield );
1687     return $is_linked->[0];
1688 }
1689
1690 1;
1691
1692 __END__
1693
1694 =head1 AUTHOR
1695
1696 Koha Team
1697
1698 =cut