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                 link_value  => 'su-to',
 682                 label_value => 'Topics',
 683                 tags        =>
 684                   [ '600', '601', '602', '603', '604', '605', '606', '610' ],
 685                 subfield => 'a',
 686             },
 687             {
 688                 link_value  => 'su-geo',
 689                 label_value => 'Places',
 690                 tags        => ['651'],
 691                 subfield    => 'a',
 692             },
 693             {
 694                 link_value  => 'su-ut',
 695                 label_value => 'Titles',
 696                 tags        => [ '500', '501', '502', '503', '504', ],
 697                 subfield    => 'a',
 698             },
 699             {
 700                 link_value  => 'au',
 701                 label_value => 'Authors',
 702                 tags        => [ '700', '701', '702', ],
 703                 subfield    => 'a',
 704             },
 705             {
 706                 link_value  => 'se',
 707                 label_value => 'Series',
 708                 tags        => ['225'],
 709                 subfield    => 'a',
 710             },
 711             ];
 712
 713             my $library_facet;
 714
 715             $library_facet = {
 716                 link_value  => 'branch',
 717                 label_value => 'Libraries',
 718                 tags        => [ '995', ],
 719                 subfield    => 'b',
 720                 expanded    => '1',
 721             };
 722             push @$facets, $library_facet unless C4::Context->preference("singleBranchMode");
 723     }
 724     else {
 725         $facets = [
 726             {
 727                 link_value  => 'su-to',
 728                 label_value => 'Topics',
 729                 tags        => ['650'],
 730                 subfield    => 'a',
 731             },
 732
 733             #        {
 734             #        link_value => 'su-na',
 735             #        label_value => 'People and Organizations',
 736             #        tags => ['600', '610', '611'],
 737             #        subfield => 'a',
 738             #        },
 739             {
 740                 link_value  => 'su-geo',
 741                 label_value => 'Places',
 742                 tags        => ['651'],
 743                 subfield    => 'a',
 744             },
 745             {
 746                 link_value  => 'su-ut',
 747                 label_value => 'Titles',
 748                 tags        => ['630'],
 749                 subfield    => 'a',
 750             },
 751             {
 752                 link_value  => 'au',
 753                 label_value => 'Authors',
 754                 tags        => [ '100', '110', '700', ],
 755                 subfield    => 'a',
 756             },
 757             {
 758                 link_value  => 'se',
 759                 label_value => 'Series',
 760                 tags        => [ '440', '490', ],
 761                 subfield    => 'a',
 762             },
 763             ];
 764             my $library_facet;
 765             $library_facet = {
 766                 link_value  => 'branch',
 767                 label_value => 'Libraries',
 768                 tags        => [ '952', ],
 769                 subfield    => 'b',
 770                 expanded    => '1',
 771             };
 772             push @$facets, $library_facet unless C4::Context->preference("singleBranchMode");
 773     }
 774     return $facets;
 775 }
 776
 777 =head2 get_infos_of
 778
 779 Return a href where a key is associated to a href. You give a query,
 780 the name of the key among the fields returned by the query. If you
 781 also give as third argument the name of the value, the function
 782 returns a href of scalar. The optional 4th argument is an arrayref of
 783 items passed to the C<execute()> call. It is designed to bind
 784 parameters to any placeholders in your SQL.
 785
 786   my $query = '
 787 SELECT itemnumber,
 788        notforloan,
 789        barcode
 790   FROM items
 791 ';
 792
 793   # generic href of any information on the item, href of href.
 794   my $iteminfos_of = get_infos_of($query, 'itemnumber');
 795   print $iteminfos_of->{$itemnumber}{barcode};
 796
 797   # specific information, href of scalar
 798   my $barcode_of_item = get_infos_of($query, 'itemnumber', 'barcode');
 799   print $barcode_of_item->{$itemnumber};
 800
 801 =cut
 802
 803 sub get_infos_of {
 804     my ( $query, $key_name, $value_name, $bind_params ) = @_;
 805
 806     my $dbh = C4::Context->dbh;
 807
 808     my $sth = $dbh->prepare($query);
 809     $sth->execute( @$bind_params );
 810
 811     my %infos_of;
 812     while ( my $row = $sth->fetchrow_hashref ) {
 813         if ( defined $value_name ) {
 814             $infos_of{ $row->{$key_name} } = $row->{$value_name};
 815         }
 816         else {
 817             $infos_of{ $row->{$key_name} } = $row;
 818         }
 819     }
 820     $sth->finish;
 821
 822     return \%infos_of;
 823 }
 824
 825 =head2 get_notforloan_label_of
 826
 827   my $notforloan_label_of = get_notforloan_label_of();
 828
 829 Each authorised value of notforloan (information available in items and
 830 itemtypes) is link to a single label.
 831
 832 Returns a href where keys are authorised values and values are corresponding
 833 labels.
 834
 835   foreach my $authorised_value (keys %{$notforloan_label_of}) {
 836     printf(
 837         "authorised_value: %s => %s\n",
 838         $authorised_value,
 839         $notforloan_label_of->{$authorised_value}
 840     );
 841   }
 842
 843 =cut
 844
 845 # FIXME - why not use GetAuthorisedValues ??
 846 #
 847 sub get_notforloan_label_of {
 848     my $dbh = C4::Context->dbh;
 849
 850     my $query = '
 851 SELECT authorised_value
 852   FROM marc_subfield_structure
 853   WHERE kohafield = \'items.notforloan\'
 854   LIMIT 0, 1
 855 ';
 856     my $sth = $dbh->prepare($query);
 857     $sth->execute();
 858     my ($statuscode) = $sth->fetchrow_array();
 859
 860     $query = '
 861 SELECT lib,
 862        authorised_value
 863   FROM authorised_values
 864   WHERE category = ?
 865 ';
 866     $sth = $dbh->prepare($query);
 867     $sth->execute($statuscode);
 868     my %notforloan_label_of;
 869     while ( my $row = $sth->fetchrow_hashref ) {
 870         $notforloan_label_of{ $row->{authorised_value} } = $row->{lib};
 871     }
 872     $sth->finish;
 873
 874     return \%notforloan_label_of;
 875 }
 876
 877 =head2 displayServers
 878
 879    my $servers = displayServers();
 880    my $servers = displayServers( $position );
 881    my $servers = displayServers( $position, $type );
 882
 883 displayServers returns a listref of hashrefs, each containing
 884 information about available z3950 servers. Each hashref has a format
 885 like:
 886
 887     {
 888       'checked'    => 'checked',
 889       'encoding'   => 'MARC-8'
 890       'icon'       => undef,
 891       'id'         => 'LIBRARY OF CONGRESS',
 892       'label'      => '',
 893       'name'       => 'server',
 894       'opensearch' => '',
 895       'value'      => 'z3950.loc.gov:7090/',
 896       'zed'        => 1,
 897     },
 898
 899 =cut
 900
 901 sub displayServers {
 902     my ( $position, $type ) = @_;
 903     my $dbh = C4::Context->dbh;
 904
 905     my $strsth = 'SELECT * FROM z3950servers';
 906     my @where_clauses;
 907     my @bind_params;
 908
 909     if ($position) {
 910         push @bind_params,   $position;
 911         push @where_clauses, ' position = ? ';
 912     }
 913
 914     if ($type) {
 915         push @bind_params,   $type;
 916         push @where_clauses, ' type = ? ';
 917     }
 918
 919     # reassemble where clause from where clause pieces
 920     if (@where_clauses) {
 921         $strsth .= ' WHERE ' . join( ' AND ', @where_clauses );
 922     }
 923
 924     my $rq = $dbh->prepare($strsth);
 925     $rq->execute(@bind_params);
 926     my @primaryserverloop;
 927
 928     while ( my $data = $rq->fetchrow_hashref ) {
 929         push @primaryserverloop,
 930           { label    => $data->{description},
 931             id       => $data->{name},
 932             name     => "server",
 933             value    => $data->{host} . ":" . $data->{port} . "/" . $data->{database},
 934             encoding => ( $data->{encoding} ? $data->{encoding} : "iso-5426" ),
 935             checked  => "checked",
 936             icon     => $data->{icon},
 937             zed        => $data->{type} eq 'zed',
 938             opensearch => $data->{type} eq 'opensearch'
 939           };
 940     }
 941     return \@primaryserverloop;
 942 }
 943
 944
 945 =head2 GetKohaImageurlFromAuthorisedValues
 946
 947 $authhorised_value = GetKohaImageurlFromAuthorisedValues( $category, $authvalcode );
 948
 949 Return the first url of the authorised value image represented by $lib.
 950
 951 =cut
 952
 953 sub GetKohaImageurlFromAuthorisedValues {
 954     my ( $category, $lib ) = @_;
 955     my $dbh = C4::Context->dbh;
 956     my $sth = $dbh->prepare("SELECT imageurl FROM authorised_values WHERE category=? AND lib =?");
 957     $sth->execute( $category, $lib );
 958     while ( my $data = $sth->fetchrow_hashref ) {
 959         return $data->{'imageurl'};
 960     }
 961 }
 962
 963 =head2 GetAuthValCode
 964
 965   $authvalcode = GetAuthValCode($kohafield,$frameworkcode);
 966
 967 =cut
 968
 969 sub GetAuthValCode {
 970         my ($kohafield,$fwcode) = @_;
 971         my $dbh = C4::Context->dbh;
 972         $fwcode='' unless $fwcode;
 973         my $sth = $dbh->prepare('select authorised_value from marc_subfield_structure where kohafield=? and frameworkcode=?');
 974         $sth->execute($kohafield,$fwcode);
 975         my ($authvalcode) = $sth->fetchrow_array;
 976         return $authvalcode;
 977 }
 978
 979 =head2 GetAuthValCodeFromField
 980
 981   $authvalcode = GetAuthValCodeFromField($field,$subfield,$frameworkcode);
 982
 983 C<$subfield> can be undefined
 984
 985 =cut
 986
 987 sub GetAuthValCodeFromField {
 988         my ($field,$subfield,$fwcode) = @_;
 989         my $dbh = C4::Context->dbh;
 990         $fwcode='' unless $fwcode;
 991         my $sth;
 992         if (defined $subfield) {
 993             $sth = $dbh->prepare('select authorised_value from marc_subfield_structure where tagfield=? and tagsubfield=? and frameworkcode=?');
 994             $sth->execute($field,$subfield,$fwcode);
 995         } else {
 996             $sth = $dbh->prepare('select authorised_value from marc_tag_structure where tagfield=? and frameworkcode=?');
 997             $sth->execute($field,$fwcode);
 998         }
 999         my ($authvalcode) = $sth->fetchrow_array;
1000         return $authvalcode;
1001 }
1002
1003 =head2 GetAuthorisedValues
1004
1005   $authvalues = GetAuthorisedValues([$category], [$selected]);
1006
1007 This function returns all authorised values from the'authorised_value' table in a reference to array of hashrefs.
1008
1009 C<$category> returns authorised values for just one category (optional).
1010
1011 C<$opac> If set to a true value, displays OPAC descriptions rather than normal ones when they exist.
1012
1013 =cut
1014
1015 sub GetAuthorisedValues {
1016     my ($category,$selected,$opac) = @_;
1017         my @results;
1018     my $dbh      = C4::Context->dbh;
1019     my $query    = "SELECT * FROM authorised_values";
1020     $query .= " WHERE category = '" . $category . "'" if $category;
1021     $query .= " ORDER BY category, lib, lib_opac";
1022     my $sth = $dbh->prepare($query);
1023     $sth->execute;
1024         while (my $data=$sth->fetchrow_hashref) {
1025             if ($selected && $selected eq $data->{'authorised_value'} ) {
1026                     $data->{'selected'} = 1;
1027             }
1028             if ($opac && $data->{'lib_opac'}) {
1029                 $data->{'lib'} = $data->{'lib_opac'};
1030             }
1031             push @results, $data;
1032         }
1033     #my $data = $sth->fetchall_arrayref({});
1034     return \@results; #$data;
1035 }
1036
1037 =head2 GetAuthorisedValueCategories
1038
1039   $auth_categories = GetAuthorisedValueCategories();
1040
1041 Return an arrayref of all of the available authorised
1042 value categories.
1043
1044 =cut
1045
1046 sub GetAuthorisedValueCategories {
1047     my $dbh = C4::Context->dbh;
1048     my $sth = $dbh->prepare("SELECT DISTINCT category FROM authorised_values ORDER BY category");
1049     $sth->execute;
1050     my @results;
1051     while (defined (my $category  = $sth->fetchrow_array) ) {
1052         push @results, $category;
1053     }
1054     return \@results;
1055 }
1056
1057 =head2 GetAuthorisedValueByCode
1058
1059 $authhorised_value = GetAuthorisedValueByCode( $category, $authvalcode );
1060
1061 Return the lib attribute from authorised_values from the row identified
1062 by the passed category and code
1063
1064 =cut
1065
1066 sub GetAuthorisedValueByCode {
1067     my ( $category, $authvalcode ) = @_;
1068
1069     my $dbh = C4::Context->dbh;
1070     my $sth = $dbh->prepare("SELECT lib FROM authorised_values WHERE category=? AND authorised_value =?");
1071     $sth->execute( $category, $authvalcode );
1072     while ( my $data = $sth->fetchrow_hashref ) {
1073         return $data->{'lib'};
1074     }
1075 }
1076
1077 =head2 GetKohaAuthorisedValues
1078
1079 Takes $kohafield, $fwcode as parameters.
1080
1081 If $opac parameter is set to a true value, displays OPAC descriptions rather than normal ones when they exist.
1082
1083 Returns hashref of Code => description
1084
1085 Returns undef if no authorised value category is defined for the kohafield.
1086
1087 =cut
1088
1089 sub GetKohaAuthorisedValues {
1090   my ($kohafield,$fwcode,$opac) = @_;
1091   $fwcode='' unless $fwcode;
1092   my %values;
1093   my $dbh = C4::Context->dbh;
1094   my $avcode = GetAuthValCode($kohafield,$fwcode);
1095   if ($avcode) {
1096         my $sth = $dbh->prepare("select authorised_value, lib, lib_opac from authorised_values where category=? ");
1097         $sth->execute($avcode);
1098         while ( my ($val, $lib, $lib_opac) = $sth->fetchrow_array ) {
1099                 $values{$val} = ($opac && $lib_opac) ? $lib_opac : $lib;
1100         }
1101         return \%values;
1102   } else {
1103         return undef;
1104   }
1105 }
1106
1107 =head2 GetKohaAuthorisedValuesFromField
1108
1109 Takes $field, $subfield, $fwcode as parameters.
1110
1111 If $opac parameter is set to a true value, displays OPAC descriptions rather than normal ones when they exist.
1112 $subfield can be undefined
1113
1114 Returns hashref of Code => description
1115
1116 Returns undef if no authorised value category is defined for the given field and subfield
1117
1118 =cut
1119
1120 sub GetKohaAuthorisedValuesFromField {
1121   my ($field, $subfield, $fwcode,$opac) = @_;
1122   $fwcode='' unless $fwcode;
1123   my %values;
1124   my $dbh = C4::Context->dbh;
1125   my $avcode = GetAuthValCodeFromField($field, $subfield, $fwcode);
1126   if ($avcode) {
1127         my $sth = $dbh->prepare("select authorised_value, lib, lib_opac from authorised_values where category=? ");
1128         $sth->execute($avcode);
1129         while ( my ($val, $lib, $lib_opac) = $sth->fetchrow_array ) {
1130                 $values{$val} = ($opac && $lib_opac) ? $lib_opac : $lib;
1131         }
1132         return \%values;
1133   } else {
1134         return undef;
1135   }
1136 }
1137
1138 =head2 xml_escape
1139
1140   my $escaped_string = C4::Koha::xml_escape($string);
1141
1142 Convert &, <, >, ', and " in a string to XML entities
1143
1144 =cut
1145
1146 sub xml_escape {
1147     my $str = shift;
1148     return '' unless defined $str;
1149     $str =~ s/&/&amp;/g;
1150     $str =~ s/</&lt;/g;
1151     $str =~ s/>/&gt;/g;
1152     $str =~ s/'/&apos;/g;
1153     $str =~ s/"/&quot;/g;
1154     return $str;
1155 }
1156
1157 =head2 GetKohaAuthorisedValueLib
1158
1159 Takes $category, $authorised_value as parameters.
1160
1161 If $opac parameter is set to a true value, displays OPAC descriptions rather than normal ones when they exist.
1162
1163 Returns authorised value description
1164
1165 =cut
1166
1167 sub GetKohaAuthorisedValueLib {
1168   my ($category,$authorised_value,$opac) = @_;
1169   my $value;
1170   my $dbh = C4::Context->dbh;
1171   my $sth = $dbh->prepare("select lib, lib_opac from authorised_values where category=? and authorised_value=?");
1172   $sth->execute($category,$authorised_value);
1173   my $data = $sth->fetchrow_hashref;
1174   $value = ($opac && $$data{'lib_opac'}) ? $$data{'lib_opac'} : $$data{'lib'};
1175   return $value;
1176 }
1177
1178 =head2 display_marc_indicators
1179
1180   my $display_form = C4::Koha::display_marc_indicators($field);
1181
1182 C<$field> is a MARC::Field object
1183
1184 Generate a display form of the indicators of a variable
1185 MARC field, replacing any blanks with '#'.
1186
1187 =cut
1188
1189 sub display_marc_indicators {
1190     my $field = shift;
1191     my $indicators = '';
1192     if ($field->tag() >= 10) {
1193         $indicators = $field->indicator(1) . $field->indicator(2);
1194         $indicators =~ s/ /#/g;
1195     }
1196     return $indicators;
1197 }
1198
1199 sub GetNormalizedUPC {
1200  my ($record,$marcflavour) = @_;
1201     my (@fields,$upc);
1202
1203     if ($marcflavour eq 'UNIMARC') {
1204         @fields = $record->field('072');
1205         foreach my $field (@fields) {
1206             my $upc = _normalize_match_point($field->subfield('a'));
1207             if ($upc ne '') {
1208                 return $upc;
1209             }
1210         }
1211
1212     }
1213     else { # assume marc21 if not unimarc
1214         @fields = $record->field('024');
1215         foreach my $field (@fields) {
1216             my $indicator = $field->indicator(1);
1217             my $upc = _normalize_match_point($field->subfield('a'));
1218             if ($indicator == 1 and $upc ne '') {
1219                 return $upc;
1220             }
1221         }
1222     }
1223 }
1224
1225 # Normalizes and returns the first valid ISBN found in the record
1226 # ISBN13 are converted into ISBN10. This is required to get Amazon cover book.
1227 sub GetNormalizedISBN {
1228     my ($isbn,$record,$marcflavour) = @_;
1229     my @fields;
1230     if ($isbn) {
1231         # Koha attempts to store multiple ISBNs in biblioitems.isbn, separated by " | "
1232         # anything after " | " should be removed, along with the delimiter
1233         $isbn =~ s/(.*)( \| )(.*)/$1/;
1234         return _isbn_cleanup($isbn);
1235     }
1236     return undef unless $record;
1237
1238     if ($marcflavour eq 'UNIMARC') {
1239         @fields = $record->field('010');
1240         foreach my $field (@fields) {
1241             my $isbn = $field->subfield('a');
1242             if ($isbn) {
1243                 return _isbn_cleanup($isbn);
1244             } else {
1245                 return undef;
1246             }
1247         }
1248     }
1249     else { # assume marc21 if not unimarc
1250         @fields = $record->field('020');
1251         foreach my $field (@fields) {
1252             $isbn = $field->subfield('a');
1253             if ($isbn) {
1254                 return _isbn_cleanup($isbn);
1255             } else {
1256                 return undef;
1257             }
1258         }
1259     }
1260 }
1261
1262 sub GetNormalizedEAN {
1263     my ($record,$marcflavour) = @_;
1264     my (@fields,$ean);
1265
1266     if ($marcflavour eq 'UNIMARC') {
1267         @fields = $record->field('073');
1268         foreach my $field (@fields) {
1269             $ean = _normalize_match_point($field->subfield('a'));
1270             if ($ean ne '') {
1271                 return $ean;
1272             }
1273         }
1274     }
1275     else { # assume marc21 if not unimarc
1276         @fields = $record->field('024');
1277         foreach my $field (@fields) {
1278             my $indicator = $field->indicator(1);
1279             $ean = _normalize_match_point($field->subfield('a'));
1280             if ($indicator == 3 and $ean ne '') {
1281                 return $ean;
1282             }
1283         }
1284     }
1285 }
1286 sub GetNormalizedOCLCNumber {
1287     my ($record,$marcflavour) = @_;
1288     my (@fields,$oclc);
1289
1290     if ($marcflavour eq 'UNIMARC') {
1291         # TODO: add UNIMARC fields
1292     }
1293     else { # assume marc21 if not unimarc
1294         @fields = $record->field('035');
1295         foreach my $field (@fields) {
1296             $oclc = $field->subfield('a');
1297             if ($oclc =~ /OCoLC/) {
1298                 $oclc =~ s/\(OCoLC\)//;
1299                 return $oclc;
1300             } else {
1301                 return undef;
1302             }
1303         }
1304     }
1305 }
1306
1307 sub _normalize_match_point {
1308     my $match_point = shift;
1309     (my $normalized_match_point) = $match_point =~ /([\d-]*[X]*)/;
1310     $normalized_match_point =~ s/-//g;
1311
1312     return $normalized_match_point;
1313 }
1314
1315 sub _isbn_cleanup {
1316     require Business::ISBN;
1317     my $isbn = Business::ISBN->new( $_[0] );
1318     if ( $isbn ) {
1319         $isbn = $isbn->as_isbn10 if $isbn->type eq 'ISBN13';
1320         if (defined $isbn) {
1321             return $isbn->as_string([]);
1322         }
1323     }
1324     return;
1325 }
1326
1327 1;
1328
1329 __END__
1330
1331 =head1 AUTHOR
1332
1333 Koha Team
1334
1335 =cut