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