C4/Koha.pm

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