C4/Koha.pm

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