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