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 ($selected && $selected eq $data->{'authorised_value'} ) {
1020                     $data->{'selected'} = 1;
1021             }
1022             if ($opac && $data->{'lib_opac'}) {
1023                 $data->{'lib'} = $data->{'lib_opac'};
1024             }
1025             push @results, $data;
1026         }
1027     #my $data = $sth->fetchall_arrayref({});
1028     return \@results; #$data;
1029 }
1030
1031 =head2 GetAuthorisedValueCategories
1032
1033   $auth_categories = GetAuthorisedValueCategories();
1034
1035 Return an arrayref of all of the available authorised
1036 value categories.
1037
1038 =cut
1039
1040 sub GetAuthorisedValueCategories {
1041     my $dbh = C4::Context->dbh;
1042     my $sth = $dbh->prepare("SELECT DISTINCT category FROM authorised_values ORDER BY category");
1043     $sth->execute;
1044     my @results;
1045     while (defined (my $category  = $sth->fetchrow_array) ) {
1046         push @results, $category;
1047     }
1048     return \@results;
1049 }
1050
1051 =head2 GetAuthorisedValueByCode
1052
1053 $authhorised_value = GetAuthorisedValueByCode( $category, $authvalcode );
1054
1055 Return the lib attribute from authorised_values from the row identified
1056 by the passed category and code
1057
1058 =cut
1059
1060 sub GetAuthorisedValueByCode {
1061     my ( $category, $authvalcode ) = @_;
1062
1063     my $dbh = C4::Context->dbh;
1064     my $sth = $dbh->prepare("SELECT lib FROM authorised_values WHERE category=? AND authorised_value =?");
1065     $sth->execute( $category, $authvalcode );
1066     while ( my $data = $sth->fetchrow_hashref ) {
1067         return $data->{'lib'};
1068     }
1069 }
1070
1071 =head2 GetKohaAuthorisedValues
1072
1073 Takes $kohafield, $fwcode as parameters.
1074
1075 If $opac parameter is set to a true value, displays OPAC descriptions rather than normal ones when they exist.
1076
1077 Returns hashref of Code => description
1078
1079 Returns undef if no authorised value category is defined for the kohafield.
1080
1081 =cut
1082
1083 sub GetKohaAuthorisedValues {
1084   my ($kohafield,$fwcode,$opac) = @_;
1085   $fwcode='' unless $fwcode;
1086   my %values;
1087   my $dbh = C4::Context->dbh;
1088   my $avcode = GetAuthValCode($kohafield,$fwcode);
1089   if ($avcode) {
1090         my $sth = $dbh->prepare("select authorised_value, lib, lib_opac from authorised_values where category=? ");
1091         $sth->execute($avcode);
1092         while ( my ($val, $lib, $lib_opac) = $sth->fetchrow_array ) {
1093                 $values{$val} = ($opac && $lib_opac) ? $lib_opac : $lib;
1094         }
1095         return \%values;
1096   } else {
1097         return undef;
1098   }
1099 }
1100
1101 =head2 GetKohaAuthorisedValuesFromField
1102
1103 Takes $field, $subfield, $fwcode as parameters.
1104
1105 If $opac parameter is set to a true value, displays OPAC descriptions rather than normal ones when they exist.
1106 $subfield can be undefined
1107
1108 Returns hashref of Code => description
1109
1110 Returns undef if no authorised value category is defined for the given field and subfield
1111
1112 =cut
1113
1114 sub GetKohaAuthorisedValuesFromField {
1115   my ($field, $subfield, $fwcode,$opac) = @_;
1116   $fwcode='' unless $fwcode;
1117   my %values;
1118   my $dbh = C4::Context->dbh;
1119   my $avcode = GetAuthValCodeFromField($field, $subfield, $fwcode);
1120   if ($avcode) {
1121         my $sth = $dbh->prepare("select authorised_value, lib, lib_opac from authorised_values where category=? ");
1122         $sth->execute($avcode);
1123         while ( my ($val, $lib, $lib_opac) = $sth->fetchrow_array ) {
1124                 $values{$val} = ($opac && $lib_opac) ? $lib_opac : $lib;
1125         }
1126         return \%values;
1127   } else {
1128         return undef;
1129   }
1130 }
1131
1132 =head2 xml_escape
1133
1134   my $escaped_string = C4::Koha::xml_escape($string);
1135
1136 Convert &, <, >, ', and " in a string to XML entities
1137
1138 =cut
1139
1140 sub xml_escape {
1141     my $str = shift;
1142     return '' unless defined $str;
1143     $str =~ s/&/&amp;/g;
1144     $str =~ s/</&lt;/g;
1145     $str =~ s/>/&gt;/g;
1146     $str =~ s/'/&apos;/g;
1147     $str =~ s/"/&quot;/g;
1148     return $str;
1149 }
1150
1151 =head2 GetKohaAuthorisedValueLib
1152
1153 Takes $category, $authorised_value as parameters.
1154
1155 If $opac parameter is set to a true value, displays OPAC descriptions rather than normal ones when they exist.
1156
1157 Returns authorised value description
1158
1159 =cut
1160
1161 sub GetKohaAuthorisedValueLib {
1162   my ($category,$authorised_value,$opac) = @_;
1163   my $value;
1164   my $dbh = C4::Context->dbh;
1165   my $sth = $dbh->prepare("select lib, lib_opac from authorised_values where category=? and authorised_value=?");
1166   $sth->execute($category,$authorised_value);
1167   my $data = $sth->fetchrow_hashref;
1168   $value = ($opac && $$data{'lib_opac'}) ? $$data{'lib_opac'} : $$data{'lib'};
1169   return $value;
1170 }
1171
1172 =head2 display_marc_indicators
1173
1174   my $display_form = C4::Koha::display_marc_indicators($field);
1175
1176 C<$field> is a MARC::Field object
1177
1178 Generate a display form of the indicators of a variable
1179 MARC field, replacing any blanks with '#'.
1180
1181 =cut
1182
1183 sub display_marc_indicators {
1184     my $field = shift;
1185     my $indicators = '';
1186     if ($field->tag() >= 10) {
1187         $indicators = $field->indicator(1) . $field->indicator(2);
1188         $indicators =~ s/ /#/g;
1189     }
1190     return $indicators;
1191 }
1192
1193 sub GetNormalizedUPC {
1194  my ($record,$marcflavour) = @_;
1195     my (@fields,$upc);
1196
1197     if ($marcflavour eq 'UNIMARC') {
1198         @fields = $record->field('072');
1199         foreach my $field (@fields) {
1200             my $upc = _normalize_match_point($field->subfield('a'));
1201             if ($upc ne '') {
1202                 return $upc;
1203             }
1204         }
1205
1206     }
1207     else { # assume marc21 if not unimarc
1208         @fields = $record->field('024');
1209         foreach my $field (@fields) {
1210             my $indicator = $field->indicator(1);
1211             my $upc = _normalize_match_point($field->subfield('a'));
1212             if ($indicator == 1 and $upc ne '') {
1213                 return $upc;
1214             }
1215         }
1216     }
1217 }
1218
1219 # Normalizes and returns the first valid ISBN found in the record
1220 # ISBN13 are converted into ISBN10. This is required to get Amazon cover book.
1221 sub GetNormalizedISBN {
1222     my ($isbn,$record,$marcflavour) = @_;
1223     my @fields;
1224     if ($isbn) {
1225         # Koha attempts to store multiple ISBNs in biblioitems.isbn, separated by " | "
1226         # anything after " | " should be removed, along with the delimiter
1227         $isbn =~ s/(.*)( \| )(.*)/$1/;
1228         return _isbn_cleanup($isbn);
1229     }
1230     return undef unless $record;
1231
1232     if ($marcflavour eq 'UNIMARC') {
1233         @fields = $record->field('010');
1234         foreach my $field (@fields) {
1235             my $isbn = $field->subfield('a');
1236             if ($isbn) {
1237                 return _isbn_cleanup($isbn);
1238             } else {
1239                 return undef;
1240             }
1241         }
1242     }
1243     else { # assume marc21 if not unimarc
1244         @fields = $record->field('020');
1245         foreach my $field (@fields) {
1246             $isbn = $field->subfield('a');
1247             if ($isbn) {
1248                 return _isbn_cleanup($isbn);
1249             } else {
1250                 return undef;
1251             }
1252         }
1253     }
1254 }
1255
1256 sub GetNormalizedEAN {
1257     my ($record,$marcflavour) = @_;
1258     my (@fields,$ean);
1259
1260     if ($marcflavour eq 'UNIMARC') {
1261         @fields = $record->field('073');
1262         foreach my $field (@fields) {
1263             $ean = _normalize_match_point($field->subfield('a'));
1264             if ($ean ne '') {
1265                 return $ean;
1266             }
1267         }
1268     }
1269     else { # assume marc21 if not unimarc
1270         @fields = $record->field('024');
1271         foreach my $field (@fields) {
1272             my $indicator = $field->indicator(1);
1273             $ean = _normalize_match_point($field->subfield('a'));
1274             if ($indicator == 3 and $ean ne '') {
1275                 return $ean;
1276             }
1277         }
1278     }
1279 }
1280 sub GetNormalizedOCLCNumber {
1281     my ($record,$marcflavour) = @_;
1282     my (@fields,$oclc);
1283
1284     if ($marcflavour eq 'UNIMARC') {
1285         # TODO: add UNIMARC fields
1286     }
1287     else { # assume marc21 if not unimarc
1288         @fields = $record->field('035');
1289         foreach my $field (@fields) {
1290             $oclc = $field->subfield('a');
1291             if ($oclc =~ /OCoLC/) {
1292                 $oclc =~ s/\(OCoLC\)//;
1293                 return $oclc;
1294             } else {
1295                 return undef;
1296             }
1297         }
1298     }
1299 }
1300
1301 sub _normalize_match_point {
1302     my $match_point = shift;
1303     (my $normalized_match_point) = $match_point =~ /([\d-]*[X]*)/;
1304     $normalized_match_point =~ s/-//g;
1305
1306     return $normalized_match_point;
1307 }
1308
1309 sub _isbn_cleanup {
1310     require Business::ISBN;
1311     my $isbn = Business::ISBN->new( $_[0] );
1312     if ( $isbn ) {
1313         $isbn = $isbn->as_isbn10 if $isbn->type eq 'ISBN13';
1314         if (defined $isbn) {
1315             return $isbn->as_string([]);
1316         }
1317     }
1318     return;
1319 }
1320
1321 1;
1322
1323 __END__
1324
1325 =head1 AUTHOR
1326
1327 Koha Team
1328
1329 =cut