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 use C4::Context;
  26 use Memoize;
  27
  28 use vars qw($VERSION @ISA @EXPORT $DEBUG);
  29
  30 BEGIN {
  31         $VERSION = 3.01;
  32         require Exporter;
  33         @ISA    = qw(Exporter);
  34         @EXPORT = qw(
  35                 &slashifyDate
  36                 &subfield_is_koha_internal_p
  37                 &GetPrinters &GetPrinter
  38                 &GetItemTypes &getitemtypeinfo
  39                 &GetCcodes
  40                 &GetSupportName &GetSupportList
  41                 &get_itemtypeinfos_of
  42                 &getframeworks &getframeworkinfo
  43                 &getauthtypes &getauthtype
  44                 &getallthemes
  45                 &getFacets
  46                 &displayServers
  47                 &getnbpages
  48                 &get_infos_of
  49                 &get_notforloan_label_of
  50                 &getitemtypeimagedir
  51                 &getitemtypeimagesrc
  52                 &getitemtypeimagelocation
  53                 &GetAuthorisedValues
  54                 &GetAuthorisedValueCategories
  55                 &GetKohaAuthorisedValues
  56                 &GetKohaAuthorisedValuesFromField
  57     &GetKohaAuthorisedValueLib
  58     &GetAuthorisedValueByCode
  59     &GetKohaImageurlFromAuthorisedValues
  60                 &GetAuthValCode
  61                 &GetNormalizedUPC
  62                 &GetNormalizedISBN
  63                 &GetNormalizedEAN
  64                 &GetNormalizedOCLCNumber
  65         &xml_escape
  66
  67                 $DEBUG
  68         );
  69         $DEBUG = 0;
  70 }
  71
  72 # expensive functions
  73 memoize('GetAuthorisedValues');
  74
  75 =head1 NAME
  76
  77 C4::Koha - Perl Module containing convenience functions for Koha scripts
  78
  79 =head1 SYNOPSIS
  80
  81 use C4::Koha;
  82
  83 =head1 DESCRIPTION
  84
  85 Koha.pm provides many functions for Koha scripts.
  86
  87 =head1 FUNCTIONS
  88
  89 =cut
  90
  91 =head2 slashifyDate
  92
  93   $slash_date = &slashifyDate($dash_date);
  94
  95 Takes a string of the form "DD-MM-YYYY" (or anything separated by
  96 dashes), converts it to the form "YYYY/MM/DD", and returns the result.
  97
  98 =cut
  99
 100 sub slashifyDate {
 101
 102     # accepts a date of the form xx-xx-xx[xx] and returns it in the
 103     # form xx/xx/xx[xx]
 104     my @dateOut = split( '-', shift );
 105     return ("$dateOut[2]/$dateOut[1]/$dateOut[0]");
 106 }
 107
 108 # FIXME.. this should be moved to a MARC-specific module
 109 sub subfield_is_koha_internal_p ($) {
 110     my ($subfield) = @_;
 111
 112     # We could match on 'lib' and 'tab' (and 'mandatory', & more to come!)
 113     # But real MARC subfields are always single-character
 114     # so it really is safer just to check the length
 115
 116     return length $subfield != 1;
 117 }
 118
 119 =head2 GetSupportName
 120
 121   $itemtypename = &GetSupportName($codestring);
 122
 123 Returns a string with the name of the itemtype.
 124
 125 =cut
 126
 127 sub GetSupportName{
 128         my ($codestring)=@_;
 129         return if (! $codestring);
 130         my $resultstring;
 131         my $advanced_search_types = C4::Context->preference("AdvancedSearchTypes");
 132         if (!$advanced_search_types or $advanced_search_types eq 'itemtypes') {
 133                 my $query = qq|
 134                         SELECT description
 135                         FROM   itemtypes
 136                         WHERE itemtype=?
 137                         order by description
 138                 |;
 139                 my $sth = C4::Context->dbh->prepare($query);
 140                 $sth->execute($codestring);
 141                 ($resultstring)=$sth->fetchrow;
 142                 return $resultstring;
 143         } else {
 144         my $sth =
 145             C4::Context->dbh->prepare(
 146                     "SELECT lib FROM authorised_values WHERE category = ? AND authorised_value = ?"
 147                     );
 148         $sth->execute( $advanced_search_types, $codestring );
 149         my $data = $sth->fetchrow_hashref;
 150         return $$data{'lib'};
 151         }
 152
 153 }
 154 =head2 GetSupportList
 155
 156   $itemtypes = &GetSupportList();
 157
 158 Returns an array ref containing informations about Support (since itemtype is rather a circulation code when item-level-itypes is used).
 159
 160 build a HTML select with the following code :
 161
 162 =head3 in PERL SCRIPT
 163
 164     my $itemtypes = GetSupportList();
 165     $template->param(itemtypeloop => $itemtypes);
 166
 167 =head3 in TEMPLATE
 168
 169     <form action='<!-- TMPL_VAR name="script_name" -->' method=post>
 170         <select name="itemtype">
 171             <option value="">Default</option>
 172         <!-- TMPL_LOOP name="itemtypeloop" -->
 173             <option value="<!-- TMPL_VAR name="itemtype" -->" <!-- TMPL_IF name="selected" -->selected<!-- /TMPL_IF -->> <!--TMPL_IF Name="imageurl"--><img alt="<!-- TMPL_VAR name="description" -->" src="<!--TMPL_VAR Name="imageurl"-->><!--TMPL_ELSE-->"<!-- TMPL_VAR name="description" --><!--/TMPL_IF--></option>
 174         <!-- /TMPL_LOOP -->
 175         </select>
 176         <input type=text name=searchfield value="<!-- TMPL_VAR name="searchfield" -->">
 177         <input type="submit" value="OK" class="button">
 178     </form>
 179
 180 =cut
 181
 182 sub GetSupportList{
 183         my $advanced_search_types = C4::Context->preference("AdvancedSearchTypes");
 184         if (!$advanced_search_types or $advanced_search_types eq 'itemtypes') {
 185                 my $query = qq|
 186                         SELECT *
 187                         FROM   itemtypes
 188                         order by description
 189                 |;
 190                 my $sth = C4::Context->dbh->prepare($query);
 191                 $sth->execute;
 192                 return $sth->fetchall_arrayref({});
 193         } else {
 194                 my $advsearchtypes = GetAuthorisedValues($advanced_search_types);
 195                 my @results= map {{itemtype=>$$_{authorised_value},description=>$$_{lib},imageurl=>$$_{imageurl}}} @$advsearchtypes;
 196                 return \@results;
 197         }
 198 }
 199 =head2 GetItemTypes
 200
 201   $itemtypes = &GetItemTypes();
 202
 203 Returns information about existing itemtypes.
 204
 205 build a HTML select with the following code :
 206
 207 =head3 in PERL SCRIPT
 208
 209     my $itemtypes = GetItemTypes;
 210     my @itemtypesloop;
 211     foreach my $thisitemtype (sort keys %$itemtypes) {
 212         my $selected = 1 if $thisitemtype eq $itemtype;
 213         my %row =(value => $thisitemtype,
 214                     selected => $selected,
 215                     description => $itemtypes->{$thisitemtype}->{'description'},
 216                 );
 217         push @itemtypesloop, \%row;
 218     }
 219     $template->param(itemtypeloop => \@itemtypesloop);
 220
 221 =head3 in TEMPLATE
 222
 223     <form action='<!-- TMPL_VAR name="script_name" -->' method=post>
 224         <select name="itemtype">
 225             <option value="">Default</option>
 226         <!-- TMPL_LOOP name="itemtypeloop" -->
 227             <option value="<!-- TMPL_VAR name="value" -->" <!-- TMPL_IF name="selected" -->selected<!-- /TMPL_IF -->><!-- TMPL_VAR name="description" --></option>
 228         <!-- /TMPL_LOOP -->
 229         </select>
 230         <input type=text name=searchfield value="<!-- TMPL_VAR name="searchfield" -->">
 231         <input type="submit" value="OK" class="button">
 232     </form>
 233
 234 =cut
 235
 236 sub GetItemTypes {
 237
 238     # returns a reference to a hash of references to itemtypes...
 239     my %itemtypes;
 240     my $dbh   = C4::Context->dbh;
 241     my $query = qq|
 242         SELECT *
 243         FROM   itemtypes
 244     |;
 245     my $sth = $dbh->prepare($query);
 246     $sth->execute;
 247     while ( my $IT = $sth->fetchrow_hashref ) {
 248         $itemtypes{ $IT->{'itemtype'} } = $IT;
 249     }
 250     return ( \%itemtypes );
 251 }
 252
 253 sub get_itemtypeinfos_of {
 254     my @itemtypes = @_;
 255
 256     my $placeholders = join( ', ', map { '?' } @itemtypes );
 257     my $query = <<"END_SQL";
 258 SELECT itemtype,
 259        description,
 260        imageurl,
 261        notforloan
 262   FROM itemtypes
 263   WHERE itemtype IN ( $placeholders )
 264 END_SQL
 265
 266     return get_infos_of( $query, 'itemtype', undef, \@itemtypes );
 267 }
 268
 269 # this is temporary until we separate collection codes and item types
 270 sub GetCcodes {
 271     my $count = 0;
 272     my @results;
 273     my $dbh = C4::Context->dbh;
 274     my $sth =
 275       $dbh->prepare(
 276         "SELECT * FROM authorised_values ORDER BY authorised_value");
 277     $sth->execute;
 278     while ( my $data = $sth->fetchrow_hashref ) {
 279         if ( $data->{category} eq "CCODE" ) {
 280             $count++;
 281             $results[$count] = $data;
 282
 283             #warn "data: $data";
 284         }
 285     }
 286     $sth->finish;
 287     return ( $count, @results );
 288 }
 289
 290 =head2 getauthtypes
 291
 292   $authtypes = &getauthtypes();
 293
 294 Returns information about existing authtypes.
 295
 296 build a HTML select with the following code :
 297
 298 =head3 in PERL SCRIPT
 299
 300    my $authtypes = getauthtypes;
 301    my @authtypesloop;
 302    foreach my $thisauthtype (keys %$authtypes) {
 303        my $selected = 1 if $thisauthtype eq $authtype;
 304        my %row =(value => $thisauthtype,
 305                 selected => $selected,
 306                 authtypetext => $authtypes->{$thisauthtype}->{'authtypetext'},
 307             );
 308         push @authtypesloop, \%row;
 309     }
 310     $template->param(itemtypeloop => \@itemtypesloop);
 311
 312 =head3 in TEMPLATE
 313
 314   <form action='<!-- TMPL_VAR name="script_name" -->' method=post>
 315     <select name="authtype">
 316     <!-- TMPL_LOOP name="authtypeloop" -->
 317         <option value="<!-- TMPL_VAR name="value" -->" <!-- TMPL_IF name="selected" -->selected<!-- /TMPL_IF -->><!-- TMPL_VAR name="authtypetext" --></option>
 318     <!-- /TMPL_LOOP -->
 319     </select>
 320     <input type=text name=searchfield value="<!-- TMPL_VAR name="searchfield" -->">
 321     <input type="submit" value="OK" class="button">
 322   </form>
 323
 324
 325 =cut
 326
 327 sub getauthtypes {
 328
 329     # returns a reference to a hash of references to authtypes...
 330     my %authtypes;
 331     my $dbh = C4::Context->dbh;
 332     my $sth = $dbh->prepare("select * from auth_types order by authtypetext");
 333     $sth->execute;
 334     while ( my $IT = $sth->fetchrow_hashref ) {
 335         $authtypes{ $IT->{'authtypecode'} } = $IT;
 336     }
 337     return ( \%authtypes );
 338 }
 339
 340 sub getauthtype {
 341     my ($authtypecode) = @_;
 342
 343     # returns a reference to a hash of references to authtypes...
 344     my %authtypes;
 345     my $dbh = C4::Context->dbh;
 346     my $sth = $dbh->prepare("select * from auth_types where authtypecode=?");
 347     $sth->execute($authtypecode);
 348     my $res = $sth->fetchrow_hashref;
 349     return $res;
 350 }
 351
 352 =head2 getframework
 353
 354   $frameworks = &getframework();
 355
 356 Returns information about existing frameworks
 357
 358 build a HTML select with the following code :
 359
 360 =head3 in PERL SCRIPT
 361
 362   my $frameworks = frameworks();
 363   my @frameworkloop;
 364   foreach my $thisframework (keys %$frameworks) {
 365     my $selected = 1 if $thisframework eq $frameworkcode;
 366     my %row =(value => $thisframework,
 367                 selected => $selected,
 368                 description => $frameworks->{$thisframework}->{'frameworktext'},
 369             );
 370     push @frameworksloop, \%row;
 371   }
 372   $template->param(frameworkloop => \@frameworksloop);
 373
 374 =head3 in TEMPLATE
 375
 376   <form action='<!-- TMPL_VAR name="script_name" -->' method=post>
 377     <select name="frameworkcode">
 378         <option value="">Default</option>
 379     <!-- TMPL_LOOP name="frameworkloop" -->
 380         <option value="<!-- TMPL_VAR name="value" -->" <!-- TMPL_IF name="selected" -->selected<!-- /TMPL_IF -->><!-- TMPL_VAR name="frameworktext" --></option>
 381     <!-- /TMPL_LOOP -->
 382     </select>
 383     <input type=text name=searchfield value="<!-- TMPL_VAR name="searchfield" -->">
 384     <input type="submit" value="OK" class="button">
 385   </form>
 386
 387 =cut
 388
 389 sub getframeworks {
 390
 391     # returns a reference to a hash of references to branches...
 392     my %itemtypes;
 393     my $dbh = C4::Context->dbh;
 394     my $sth = $dbh->prepare("select * from biblio_framework");
 395     $sth->execute;
 396     while ( my $IT = $sth->fetchrow_hashref ) {
 397         $itemtypes{ $IT->{'frameworkcode'} } = $IT;
 398     }
 399     return ( \%itemtypes );
 400 }
 401
 402 =head2 getframeworkinfo
 403
 404   $frameworkinfo = &getframeworkinfo($frameworkcode);
 405
 406 Returns information about an frameworkcode.
 407
 408 =cut
 409
 410 sub getframeworkinfo {
 411     my ($frameworkcode) = @_;
 412     my $dbh             = C4::Context->dbh;
 413     my $sth             =
 414       $dbh->prepare("select * from biblio_framework where frameworkcode=?");
 415     $sth->execute($frameworkcode);
 416     my $res = $sth->fetchrow_hashref;
 417     return $res;
 418 }
 419
 420 =head2 getitemtypeinfo
 421
 422   $itemtype = &getitemtype($itemtype);
 423
 424 Returns information about an itemtype.
 425
 426 =cut
 427
 428 sub getitemtypeinfo {
 429     my ($itemtype) = @_;
 430     my $dbh        = C4::Context->dbh;
 431     my $sth        = $dbh->prepare("select * from itemtypes where itemtype=?");
 432     $sth->execute($itemtype);
 433     my $res = $sth->fetchrow_hashref;
 434
 435     $res->{imageurl} = getitemtypeimagelocation( 'intranet', $res->{imageurl} );
 436
 437     return $res;
 438 }
 439
 440 =head2 getitemtypeimagedir
 441
 442   my $directory = getitemtypeimagedir( 'opac' );
 443
 444 pass in 'opac' or 'intranet'. Defaults to 'opac'.
 445
 446 returns the full path to the appropriate directory containing images.
 447
 448 =cut
 449
 450 sub getitemtypeimagedir {
 451         my $src = shift || 'opac';
 452         if ($src eq 'intranet') {
 453                 return C4::Context->config('intrahtdocs') . '/' .C4::Context->preference('template') . '/img/itemtypeimg';
 454         } else {
 455                 return C4::Context->config('opachtdocs') . '/' . C4::Context->preference('opacthemes') . '/itemtypeimg';
 456         }
 457 }
 458
 459 sub getitemtypeimagesrc {
 460         my $src = shift || 'opac';
 461         if ($src eq 'intranet') {
 462                 return '/intranet-tmpl' . '/' . C4::Context->preference('template') . '/img/itemtypeimg';
 463         } else {
 464                 return '/opac-tmpl' . '/' . C4::Context->preference('opacthemes') . '/itemtypeimg';
 465         }
 466 }
 467
 468 sub getitemtypeimagelocation($$) {
 469         my ( $src, $image ) = @_;
 470
 471         return '' if ( !$image );
 472     require URI::Split;
 473
 474         my $scheme = ( URI::Split::uri_split( $image ) )[0];
 475
 476         return $image if ( $scheme );
 477
 478         return getitemtypeimagesrc( $src ) . '/' . $image;
 479 }
 480
 481 =head3 _getImagesFromDirectory
 482
 483 Find all of the image files in a directory in the filesystem
 484
 485 parameters: a directory name
 486
 487 returns: a list of images in that directory.
 488
 489 Notes: this does not traverse into subdirectories. See
 490 _getSubdirectoryNames for help with that.
 491 Images are assumed to be files with .gif or .png file extensions.
 492 The image names returned do not have the directory name on them.
 493
 494 =cut
 495
 496 sub _getImagesFromDirectory {
 497     my $directoryname = shift;
 498     return unless defined $directoryname;
 499     return unless -d $directoryname;
 500
 501     if ( opendir ( my $dh, $directoryname ) ) {
 502         my @images = grep { /\.(gif|png)$/i } readdir( $dh );
 503         closedir $dh;
 504         @images = sort(@images);
 505         return @images;
 506     } else {
 507         warn "unable to opendir $directoryname: $!";
 508         return;
 509     }
 510 }
 511
 512 =head3 _getSubdirectoryNames
 513
 514 Find all of the directories in a directory in the filesystem
 515
 516 parameters: a directory name
 517
 518 returns: a list of subdirectories in that directory.
 519
 520 Notes: this does not traverse into subdirectories. Only the first
 521 level of subdirectories are returned.
 522 The directory names returned don't have the parent directory name on them.
 523
 524 =cut
 525
 526 sub _getSubdirectoryNames {
 527     my $directoryname = shift;
 528     return unless defined $directoryname;
 529     return unless -d $directoryname;
 530
 531     if ( opendir ( my $dh, $directoryname ) ) {
 532         my @directories = grep { -d File::Spec->catfile( $directoryname, $_ ) && ! ( /^\./ ) } readdir( $dh );
 533         closedir $dh;
 534         return @directories;
 535     } else {
 536         warn "unable to opendir $directoryname: $!";
 537         return;
 538     }
 539 }
 540
 541 =head3 getImageSets
 542
 543 returns: a listref of hashrefs. Each hash represents another collection of images.
 544
 545  { imagesetname => 'npl', # the name of the image set (npl is the original one)
 546          images => listref of image hashrefs
 547  }
 548
 549 each image is represented by a hashref like this:
 550
 551  { KohaImage     => 'npl/image.gif',
 552    StaffImageUrl => '/intranet-tmpl/prog/img/itemtypeimg/npl/image.gif',
 553    OpacImageURL  => '/opac-tmpl/prog/itemtypeimg/npl/image.gif'
 554    checked       => 0 or 1: was this the image passed to this method?
 555                     Note: I'd like to remove this somehow.
 556  }
 557
 558 =cut
 559
 560 sub getImageSets {
 561     my %params = @_;
 562     my $checked = $params{'checked'} || '';
 563
 564     my $paths = { staff => { filesystem => getitemtypeimagedir('intranet'),
 565                              url        => getitemtypeimagesrc('intranet'),
 566                         },
 567                   opac => { filesystem => getitemtypeimagedir('opac'),
 568                              url       => getitemtypeimagesrc('opac'),
 569                         }
 570                   };
 571
 572     my @imagesets = (); # list of hasrefs of image set data to pass to template
 573     my @subdirectories = _getSubdirectoryNames( $paths->{'staff'}{'filesystem'} );
 574     foreach my $imagesubdir ( @subdirectories ) {
 575     warn $imagesubdir if $DEBUG;
 576         my @imagelist     = (); # hashrefs of image info
 577         my @imagenames = _getImagesFromDirectory( File::Spec->catfile( $paths->{'staff'}{'filesystem'}, $imagesubdir ) );
 578         my $imagesetactive = 0;
 579         foreach my $thisimage ( @imagenames ) {
 580             push( @imagelist,
 581                   { KohaImage     => "$imagesubdir/$thisimage",
 582                     StaffImageUrl => join( '/', $paths->{'staff'}{'url'}, $imagesubdir, $thisimage ),
 583                     OpacImageUrl  => join( '/', $paths->{'opac'}{'url'}, $imagesubdir, $thisimage ),
 584                     checked       => "$imagesubdir/$thisimage" eq $checked ? 1 : 0,
 585                }
 586              );
 587              $imagesetactive = 1 if "$imagesubdir/$thisimage" eq $checked;
 588         }
 589         push @imagesets, { imagesetname => $imagesubdir,
 590                            imagesetactive => $imagesetactive,
 591                            images       => \@imagelist };
 592
 593     }
 594     return \@imagesets;
 595 }
 596
 597 =head2 GetPrinters
 598
 599   $printers = &GetPrinters();
 600   @queues = keys %$printers;
 601
 602 Returns information about existing printer queues.
 603
 604 C<$printers> is a reference-to-hash whose keys are the print queues
 605 defined in the printers table of the Koha database. The values are
 606 references-to-hash, whose keys are the fields in the printers table.
 607
 608 =cut
 609
 610 sub GetPrinters {
 611     my %printers;
 612     my $dbh = C4::Context->dbh;
 613     my $sth = $dbh->prepare("select * from printers");
 614     $sth->execute;
 615     while ( my $printer = $sth->fetchrow_hashref ) {
 616         $printers{ $printer->{'printqueue'} } = $printer;
 617     }
 618     return ( \%printers );
 619 }
 620
 621 =head2 GetPrinter
 622
 623   $printer = GetPrinter( $query, $printers );
 624
 625 =cut
 626
 627 sub GetPrinter ($$) {
 628     my ( $query, $printers ) = @_;    # get printer for this query from printers
 629     my $printer = $query->param('printer');
 630     my %cookie = $query->cookie('userenv');
 631     ($printer) || ( $printer = $cookie{'printer'} ) || ( $printer = '' );
 632     ( $printers->{$printer} ) || ( $printer = ( keys %$printers )[0] );
 633     return $printer;
 634 }
 635
 636 =head2 getnbpages
 637
 638 Returns the number of pages to display in a pagination bar, given the number
 639 of items and the number of items per page.
 640
 641 =cut
 642
 643 sub getnbpages {
 644     my ( $nb_items, $nb_items_per_page ) = @_;
 645
 646     return int( ( $nb_items - 1 ) / $nb_items_per_page ) + 1;
 647 }
 648
 649 =head2 getallthemes
 650
 651   (@themes) = &getallthemes('opac');
 652   (@themes) = &getallthemes('intranet');
 653
 654 Returns an array of all available themes.
 655
 656 =cut
 657
 658 sub getallthemes {
 659     my $type = shift;
 660     my $htdocs;
 661     my @themes;
 662     if ( $type eq 'intranet' ) {
 663         $htdocs = C4::Context->config('intrahtdocs');
 664     }
 665     else {
 666         $htdocs = C4::Context->config('opachtdocs');
 667     }
 668     opendir D, "$htdocs";
 669     my @dirlist = readdir D;
 670     foreach my $directory (@dirlist) {
 671         -d "$htdocs/$directory/en" and push @themes, $directory;
 672     }
 673     return @themes;
 674 }
 675
 676 sub getFacets {
 677     my $facets;
 678     if ( C4::Context->preference("marcflavour") eq "UNIMARC" ) {
 679         $facets = [
 680             {
 681                 idx   => 'su-to',
 682                 label => 'Topics',
 683                 tags  => [ qw/ 600a 601a 602a 603a 604a 605a 606ax 610a/ ],
 684                 sep   => ' - ',
 685             },
 686             {
 687                 idx   => 'su-geo',
 688                 label => 'Places',
 689                 tags  => [ qw/ 651a / ],
 690                 sep   => ' - ',
 691             },
 692             {
 693                 idx   => 'su-ut',
 694                 label => 'Titles',
 695                 tags  => [ qw/ 500a 501a 502a 503a 504a / ],
 696                 sep   => ', ',
 697             },
 698             {
 699                 idx   => 'au',
 700                 label => 'Authors',
 701                 tags  => [ qw/ 700ab 701ab 702ab / ],
 702                 sep   => ', ',
 703             },
 704             {
 705                 idx   => 'se',
 706                 label => 'Series',
 707                 tags  => [ qw/ 225a / ],
 708                 sep   => ', ',
 709             },
 710         ];
 711         my $library_facet = {
 712             idx   => 'branch',
 713             label => 'Libraries',
 714             tags  => [ qw/ 995b / ],
 715             expanded => '1',
 716         };
 717         push @$facets, $library_facet unless C4::Context->preference("singleBranchMode");
 718     }
 719     else {
 720         $facets = [
 721             {
 722                 idx   => 'su-to',
 723                 label => 'Topics',
 724                 tags  => [ qw/ 650a / ],
 725                 sep   => '--',
 726             },
 727             #        {
 728             #        idx   => 'su-na',
 729             #        label => 'People and Organizations',
 730             #        tags  => [ qw/ 600a 610a 611a / ],
 731             #        sep   => 'a',
 732             #        },
 733             {
 734                 idx   => 'su-geo',
 735                 label => 'Places',
 736                 tags  => [ qw/ 651a / ],
 737                 sep   => '--',
 738             },
 739             {
 740                 idx   => 'su-ut',
 741                 label => 'Titles',
 742                 tags  => [ qw/ 630a / ],
 743                 sep   => '--',
 744             },
 745             {
 746                 idx   => 'au',
 747                 label => 'Authors',
 748                 tags  => [ qw/ 100a 110a 700a / ],
 749                 sep   => ', ',
 750             },
 751             {
 752                 idx   => 'se',
 753                 label => 'Series',
 754                 tags  => [ qw/ 440a 490a / ],
 755                 sep   => ', ',
 756             },
 757             ];
 758             my $library_facet;
 759             $library_facet = {
 760                 idx   => 'branch',
 761                 label => 'Libraries',
 762                 tags  => [ qw/ 952b / ],
 763                 sep   => ', ',
 764                 expanded    => '1',
 765             };
 766             push @$facets, $library_facet unless C4::Context->preference("singleBranchMode");
 767     }
 768     return $facets;
 769 }
 770
 771 =head2 get_infos_of
 772
 773 Return a href where a key is associated to a href. You give a query,
 774 the name of the key among the fields returned by the query. If you
 775 also give as third argument the name of the value, the function
 776 returns a href of scalar. The optional 4th argument is an arrayref of
 777 items passed to the C<execute()> call. It is designed to bind
 778 parameters to any placeholders in your SQL.
 779
 780   my $query = '
 781 SELECT itemnumber,
 782        notforloan,
 783        barcode
 784   FROM items
 785 ';
 786
 787   # generic href of any information on the item, href of href.
 788   my $iteminfos_of = get_infos_of($query, 'itemnumber');
 789   print $iteminfos_of->{$itemnumber}{barcode};
 790
 791   # specific information, href of scalar
 792   my $barcode_of_item = get_infos_of($query, 'itemnumber', 'barcode');
 793   print $barcode_of_item->{$itemnumber};
 794
 795 =cut
 796
 797 sub get_infos_of {
 798     my ( $query, $key_name, $value_name, $bind_params ) = @_;
 799
 800     my $dbh = C4::Context->dbh;
 801
 802     my $sth = $dbh->prepare($query);
 803     $sth->execute( @$bind_params );
 804
 805     my %infos_of;
 806     while ( my $row = $sth->fetchrow_hashref ) {
 807         if ( defined $value_name ) {
 808             $infos_of{ $row->{$key_name} } = $row->{$value_name};
 809         }
 810         else {
 811             $infos_of{ $row->{$key_name} } = $row;
 812         }
 813     }
 814     $sth->finish;
 815
 816     return \%infos_of;
 817 }
 818
 819 =head2 get_notforloan_label_of
 820
 821   my $notforloan_label_of = get_notforloan_label_of();
 822
 823 Each authorised value of notforloan (information available in items and
 824 itemtypes) is link to a single label.
 825
 826 Returns a href where keys are authorised values and values are corresponding
 827 labels.
 828
 829   foreach my $authorised_value (keys %{$notforloan_label_of}) {
 830     printf(
 831         "authorised_value: %s => %s\n",
 832         $authorised_value,
 833         $notforloan_label_of->{$authorised_value}
 834     );
 835   }
 836
 837 =cut
 838
 839 # FIXME - why not use GetAuthorisedValues ??
 840 #
 841 sub get_notforloan_label_of {
 842     my $dbh = C4::Context->dbh;
 843
 844     my $query = '
 845 SELECT authorised_value
 846   FROM marc_subfield_structure
 847   WHERE kohafield = \'items.notforloan\'
 848   LIMIT 0, 1
 849 ';
 850     my $sth = $dbh->prepare($query);
 851     $sth->execute();
 852     my ($statuscode) = $sth->fetchrow_array();
 853
 854     $query = '
 855 SELECT lib,
 856        authorised_value
 857   FROM authorised_values
 858   WHERE category = ?
 859 ';
 860     $sth = $dbh->prepare($query);
 861     $sth->execute($statuscode);
 862     my %notforloan_label_of;
 863     while ( my $row = $sth->fetchrow_hashref ) {
 864         $notforloan_label_of{ $row->{authorised_value} } = $row->{lib};
 865     }
 866     $sth->finish;
 867
 868     return \%notforloan_label_of;
 869 }
 870
 871 =head2 displayServers
 872
 873    my $servers = displayServers();
 874    my $servers = displayServers( $position );
 875    my $servers = displayServers( $position, $type );
 876
 877 displayServers returns a listref of hashrefs, each containing
 878 information about available z3950 servers. Each hashref has a format
 879 like:
 880
 881     {
 882       'checked'    => 'checked',
 883       'encoding'   => 'MARC-8'
 884       'icon'       => undef,
 885       'id'         => 'LIBRARY OF CONGRESS',
 886       'label'      => '',
 887       'name'       => 'server',
 888       'opensearch' => '',
 889       'value'      => 'z3950.loc.gov:7090/',
 890       'zed'        => 1,
 891     },
 892
 893 =cut
 894
 895 sub displayServers {
 896     my ( $position, $type ) = @_;
 897     my $dbh = C4::Context->dbh;
 898
 899     my $strsth = 'SELECT * FROM z3950servers';
 900     my @where_clauses;
 901     my @bind_params;
 902
 903     if ($position) {
 904         push @bind_params,   $position;
 905         push @where_clauses, ' position = ? ';
 906     }
 907
 908     if ($type) {
 909         push @bind_params,   $type;
 910         push @where_clauses, ' type = ? ';
 911     }
 912
 913     # reassemble where clause from where clause pieces
 914     if (@where_clauses) {
 915         $strsth .= ' WHERE ' . join( ' AND ', @where_clauses );
 916     }
 917
 918     my $rq = $dbh->prepare($strsth);
 919     $rq->execute(@bind_params);
 920     my @primaryserverloop;
 921
 922     while ( my $data = $rq->fetchrow_hashref ) {
 923         push @primaryserverloop,
 924           { label    => $data->{description},
 925             id       => $data->{name},
 926             name     => "server",
 927             value    => $data->{host} . ":" . $data->{port} . "/" . $data->{database},
 928             encoding => ( $data->{encoding} ? $data->{encoding} : "iso-5426" ),
 929             checked  => "checked",
 930             icon     => $data->{icon},
 931             zed        => $data->{type} eq 'zed',
 932             opensearch => $data->{type} eq 'opensearch'
 933           };
 934     }
 935     return \@primaryserverloop;
 936 }
 937
 938
 939 =head2 GetKohaImageurlFromAuthorisedValues
 940
 941 $authhorised_value = GetKohaImageurlFromAuthorisedValues( $category, $authvalcode );
 942
 943 Return the first url of the authorised value image represented by $lib.
 944
 945 =cut
 946
 947 sub GetKohaImageurlFromAuthorisedValues {
 948     my ( $category, $lib ) = @_;
 949     my $dbh = C4::Context->dbh;
 950     my $sth = $dbh->prepare("SELECT imageurl FROM authorised_values WHERE category=? AND lib =?");
 951     $sth->execute( $category, $lib );
 952     while ( my $data = $sth->fetchrow_hashref ) {
 953         return $data->{'imageurl'};
 954     }
 955 }
 956
 957 =head2 GetAuthValCode
 958
 959   $authvalcode = GetAuthValCode($kohafield,$frameworkcode);
 960
 961 =cut
 962
 963 sub GetAuthValCode {
 964         my ($kohafield,$fwcode) = @_;
 965         my $dbh = C4::Context->dbh;
 966         $fwcode='' unless $fwcode;
 967         my $sth = $dbh->prepare('select authorised_value from marc_subfield_structure where kohafield=? and frameworkcode=?');
 968         $sth->execute($kohafield,$fwcode);
 969         my ($authvalcode) = $sth->fetchrow_array;
 970         return $authvalcode;
 971 }
 972
 973 =head2 GetAuthValCodeFromField
 974
 975   $authvalcode = GetAuthValCodeFromField($field,$subfield,$frameworkcode);
 976
 977 C<$subfield> can be undefined
 978
 979 =cut
 980
 981 sub GetAuthValCodeFromField {
 982         my ($field,$subfield,$fwcode) = @_;
 983         my $dbh = C4::Context->dbh;
 984         $fwcode='' unless $fwcode;
 985         my $sth;
 986         if (defined $subfield) {
 987             $sth = $dbh->prepare('select authorised_value from marc_subfield_structure where tagfield=? and tagsubfield=? and frameworkcode=?');
 988             $sth->execute($field,$subfield,$fwcode);
 989         } else {
 990             $sth = $dbh->prepare('select authorised_value from marc_tag_structure where tagfield=? and frameworkcode=?');
 991             $sth->execute($field,$fwcode);
 992         }
 993         my ($authvalcode) = $sth->fetchrow_array;
 994         return $authvalcode;
 995 }
 996
 997 =head2 GetAuthorisedValues
 998
 999   $authvalues = GetAuthorisedValues([$category], [$selected]);
1000
1001 This function returns all authorised values from the'authorised_value' table in a reference to array of hashrefs.
1002
1003 C<$category> returns authorised values for just one category (optional).
1004
1005 C<$opac> If set to a true value, displays OPAC descriptions rather than normal ones when they exist.
1006
1007 =cut
1008
1009 sub GetAuthorisedValues {
1010     my ($category,$selected,$opac) = @_;
1011     my @results;
1012     my $dbh      = C4::Context->dbh;
1013     my $query    = "SELECT * FROM authorised_values";
1014     $query .= " WHERE category = '" . $category . "'" if $category;
1015     $query .= " ORDER BY category, lib, lib_opac";
1016     my $sth = $dbh->prepare($query);
1017     $sth->execute;
1018     while (my $data=$sth->fetchrow_hashref) {
1019         if ( (defined($selected)) && ($selected eq $data->{'authorised_value'}) ) {
1020             $data->{'selected'} = 1;
1021         }
1022         else {
1023             $data->{'selected'} = 0;
1024         }
1025         if ($opac && $data->{'lib_opac'}) {
1026             $data->{'lib'} = $data->{'lib_opac'};
1027         }
1028         push @results, $data;
1029     }
1030     #my $data = $sth->fetchall_arrayref({});
1031     return \@results; #$data;
1032 }
1033
1034 =head2 GetAuthorisedValueCategories
1035
1036   $auth_categories = GetAuthorisedValueCategories();
1037
1038 Return an arrayref of all of the available authorised
1039 value categories.
1040
1041 =cut
1042
1043 sub GetAuthorisedValueCategories {
1044     my $dbh = C4::Context->dbh;
1045     my $sth = $dbh->prepare("SELECT DISTINCT category FROM authorised_values ORDER BY category");
1046     $sth->execute;
1047     my @results;
1048     while (defined (my $category  = $sth->fetchrow_array) ) {
1049         push @results, $category;
1050     }
1051     return \@results;
1052 }
1053
1054 =head2 GetAuthorisedValueByCode
1055
1056 $authhorised_value = GetAuthorisedValueByCode( $category, $authvalcode );
1057
1058 Return the lib attribute from authorised_values from the row identified
1059 by the passed category and code
1060
1061 =cut
1062
1063 sub GetAuthorisedValueByCode {
1064     my ( $category, $authvalcode ) = @_;
1065
1066     my $dbh = C4::Context->dbh;
1067     my $sth = $dbh->prepare("SELECT lib FROM authorised_values WHERE category=? AND authorised_value =?");
1068     $sth->execute( $category, $authvalcode );
1069     while ( my $data = $sth->fetchrow_hashref ) {
1070         return $data->{'lib'};
1071     }
1072 }
1073
1074 =head2 GetKohaAuthorisedValues
1075
1076 Takes $kohafield, $fwcode as parameters.
1077
1078 If $opac parameter is set to a true value, displays OPAC descriptions rather than normal ones when they exist.
1079
1080 Returns hashref of Code => description
1081
1082 Returns undef if no authorised value category is defined for the kohafield.
1083
1084 =cut
1085
1086 sub GetKohaAuthorisedValues {
1087   my ($kohafield,$fwcode,$opac) = @_;
1088   $fwcode='' unless $fwcode;
1089   my %values;
1090   my $dbh = C4::Context->dbh;
1091   my $avcode = GetAuthValCode($kohafield,$fwcode);
1092   if ($avcode) {
1093         my $sth = $dbh->prepare("select authorised_value, lib, lib_opac from authorised_values where category=? ");
1094         $sth->execute($avcode);
1095         while ( my ($val, $lib, $lib_opac) = $sth->fetchrow_array ) {
1096                 $values{$val} = ($opac && $lib_opac) ? $lib_opac : $lib;
1097         }
1098         return \%values;
1099   } else {
1100         return undef;
1101   }
1102 }
1103
1104 =head2 GetKohaAuthorisedValuesFromField
1105
1106 Takes $field, $subfield, $fwcode as parameters.
1107
1108 If $opac parameter is set to a true value, displays OPAC descriptions rather than normal ones when they exist.
1109 $subfield can be undefined
1110
1111 Returns hashref of Code => description
1112
1113 Returns undef if no authorised value category is defined for the given field and subfield
1114
1115 =cut
1116
1117 sub GetKohaAuthorisedValuesFromField {
1118   my ($field, $subfield, $fwcode,$opac) = @_;
1119   $fwcode='' unless $fwcode;
1120   my %values;
1121   my $dbh = C4::Context->dbh;
1122   my $avcode = GetAuthValCodeFromField($field, $subfield, $fwcode);
1123   if ($avcode) {
1124         my $sth = $dbh->prepare("select authorised_value, lib, lib_opac from authorised_values where category=? ");
1125         $sth->execute($avcode);
1126         while ( my ($val, $lib, $lib_opac) = $sth->fetchrow_array ) {
1127                 $values{$val} = ($opac && $lib_opac) ? $lib_opac : $lib;
1128         }
1129         return \%values;
1130   } else {
1131         return undef;
1132   }
1133 }
1134
1135 =head2 xml_escape
1136
1137   my $escaped_string = C4::Koha::xml_escape($string);
1138
1139 Convert &, <, >, ', and " in a string to XML entities
1140
1141 =cut
1142
1143 sub xml_escape {
1144     my $str = shift;
1145     return '' unless defined $str;
1146     $str =~ s/&/&amp;/g;
1147     $str =~ s/</&lt;/g;
1148     $str =~ s/>/&gt;/g;
1149     $str =~ s/'/&apos;/g;
1150     $str =~ s/"/&quot;/g;
1151     return $str;
1152 }
1153
1154 =head2 GetKohaAuthorisedValueLib
1155
1156 Takes $category, $authorised_value as parameters.
1157
1158 If $opac parameter is set to a true value, displays OPAC descriptions rather than normal ones when they exist.
1159
1160 Returns authorised value description
1161
1162 =cut
1163
1164 sub GetKohaAuthorisedValueLib {
1165   my ($category,$authorised_value,$opac) = @_;
1166   my $value;
1167   my $dbh = C4::Context->dbh;
1168   my $sth = $dbh->prepare("select lib, lib_opac from authorised_values where category=? and authorised_value=?");
1169   $sth->execute($category,$authorised_value);
1170   my $data = $sth->fetchrow_hashref;
1171   $value = ($opac && $$data{'lib_opac'}) ? $$data{'lib_opac'} : $$data{'lib'};
1172   return $value;
1173 }
1174
1175 =head2 display_marc_indicators
1176
1177   my $display_form = C4::Koha::display_marc_indicators($field);
1178
1179 C<$field> is a MARC::Field object
1180
1181 Generate a display form of the indicators of a variable
1182 MARC field, replacing any blanks with '#'.
1183
1184 =cut
1185
1186 sub display_marc_indicators {
1187     my $field = shift;
1188     my $indicators = '';
1189     if ($field->tag() >= 10) {
1190         $indicators = $field->indicator(1) . $field->indicator(2);
1191         $indicators =~ s/ /#/g;
1192     }
1193     return $indicators;
1194 }
1195
1196 sub GetNormalizedUPC {
1197  my ($record,$marcflavour) = @_;
1198     my (@fields,$upc);
1199
1200     if ($marcflavour eq 'UNIMARC') {
1201         @fields = $record->field('072');
1202         foreach my $field (@fields) {
1203             my $upc = _normalize_match_point($field->subfield('a'));
1204             if ($upc ne '') {
1205                 return $upc;
1206             }
1207         }
1208
1209     }
1210     else { # assume marc21 if not unimarc
1211         @fields = $record->field('024');
1212         foreach my $field (@fields) {
1213             my $indicator = $field->indicator(1);
1214             my $upc = _normalize_match_point($field->subfield('a'));
1215             if ($indicator == 1 and $upc ne '') {
1216                 return $upc;
1217             }
1218         }
1219     }
1220 }
1221
1222 # Normalizes and returns the first valid ISBN found in the record
1223 # ISBN13 are converted into ISBN10. This is required to get Amazon cover book.
1224 sub GetNormalizedISBN {
1225     my ($isbn,$record,$marcflavour) = @_;
1226     my @fields;
1227     if ($isbn) {
1228         # Koha attempts to store multiple ISBNs in biblioitems.isbn, separated by " | "
1229         # anything after " | " should be removed, along with the delimiter
1230         $isbn =~ s/(.*)( \| )(.*)/$1/;
1231         return _isbn_cleanup($isbn);
1232     }
1233     return undef unless $record;
1234
1235     if ($marcflavour eq 'UNIMARC') {
1236         @fields = $record->field('010');
1237         foreach my $field (@fields) {
1238             my $isbn = $field->subfield('a');
1239             if ($isbn) {
1240                 return _isbn_cleanup($isbn);
1241             } else {
1242                 return undef;
1243             }
1244         }
1245     }
1246     else { # assume marc21 if not unimarc
1247         @fields = $record->field('020');
1248         foreach my $field (@fields) {
1249             $isbn = $field->subfield('a');
1250             if ($isbn) {
1251                 return _isbn_cleanup($isbn);
1252             } else {
1253                 return undef;
1254             }
1255         }
1256     }
1257 }
1258
1259 sub GetNormalizedEAN {
1260     my ($record,$marcflavour) = @_;
1261     my (@fields,$ean);
1262
1263     if ($marcflavour eq 'UNIMARC') {
1264         @fields = $record->field('073');
1265         foreach my $field (@fields) {
1266             $ean = _normalize_match_point($field->subfield('a'));
1267             if ($ean ne '') {
1268                 return $ean;
1269             }
1270         }
1271     }
1272     else { # assume marc21 if not unimarc
1273         @fields = $record->field('024');
1274         foreach my $field (@fields) {
1275             my $indicator = $field->indicator(1);
1276             $ean = _normalize_match_point($field->subfield('a'));
1277             if ($indicator == 3 and $ean ne '') {
1278                 return $ean;
1279             }
1280         }
1281     }
1282 }
1283 sub GetNormalizedOCLCNumber {
1284     my ($record,$marcflavour) = @_;
1285     my (@fields,$oclc);
1286
1287     if ($marcflavour eq 'UNIMARC') {
1288         # TODO: add UNIMARC fields
1289     }
1290     else { # assume marc21 if not unimarc
1291         @fields = $record->field('035');
1292         foreach my $field (@fields) {
1293             $oclc = $field->subfield('a');
1294             if ($oclc =~ /OCoLC/) {
1295                 $oclc =~ s/\(OCoLC\)//;
1296                 return $oclc;
1297             } else {
1298                 return undef;
1299             }
1300         }
1301     }
1302 }
1303
1304 sub _normalize_match_point {
1305     my $match_point = shift;
1306     (my $normalized_match_point) = $match_point =~ /([\d-]*[X]*)/;
1307     $normalized_match_point =~ s/-//g;
1308
1309     return $normalized_match_point;
1310 }
1311
1312 sub _isbn_cleanup {
1313     require Business::ISBN;
1314     my $isbn = Business::ISBN->new( $_[0] );
1315     if ( $isbn ) {
1316         $isbn = $isbn->as_isbn10 if $isbn->type eq 'ISBN13';
1317         if (defined $isbn) {
1318             return $isbn->as_string([]);
1319         }
1320     }
1321     return;
1322 }
1323
1324 1;
1325
1326 __END__
1327
1328 =head1 AUTHOR
1329
1330 Koha Team
1331
1332 =cut