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