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                 &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('template') . '/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('template') . '/itemtypeimg';
 465         }
 466 }
 467
 468 sub getitemtypeimagelocation($$) {
 469         my ( $src, $image ) = @_;
 470
 471         return '' if ( !$image );
 472
 473         my $scheme = ( uri_split( $image ) )[0];
 474
 475         return $image if ( $scheme );
 476
 477         return getitemtypeimagesrc( $src ) . '/' . $image;
 478 }
 479
 480 =head3 _getImagesFromDirectory
 481
 482 Find all of the image files in a directory in the filesystem
 483
 484 parameters: a directory name
 485
 486 returns: a list of images in that directory.
 487
 488 Notes: this does not traverse into subdirectories. See
 489 _getSubdirectoryNames for help with that.
 490 Images are assumed to be files with .gif or .png file extensions.
 491 The image names returned do not have the directory name on them.
 492
 493 =cut
 494
 495 sub _getImagesFromDirectory {
 496     my $directoryname = shift;
 497     return unless defined $directoryname;
 498     return unless -d $directoryname;
 499
 500     if ( opendir ( my $dh, $directoryname ) ) {
 501         my @images = grep { /\.(gif|png)$/i } readdir( $dh );
 502         closedir $dh;
 503         @images = sort(@images);
 504         return @images;
 505     } else {
 506         warn "unable to opendir $directoryname: $!";
 507         return;
 508     }
 509 }
 510
 511 =head3 _getSubdirectoryNames
 512
 513 Find all of the directories in a directory in the filesystem
 514
 515 parameters: a directory name
 516
 517 returns: a list of subdirectories in that directory.
 518
 519 Notes: this does not traverse into subdirectories. Only the first
 520 level of subdirectories are returned.
 521 The directory names returned don't have the parent directory name on them.
 522
 523 =cut
 524
 525 sub _getSubdirectoryNames {
 526     my $directoryname = shift;
 527     return unless defined $directoryname;
 528     return unless -d $directoryname;
 529
 530     if ( opendir ( my $dh, $directoryname ) ) {
 531         my @directories = grep { -d File::Spec->catfile( $directoryname, $_ ) && ! ( /^\./ ) } readdir( $dh );
 532         closedir $dh;
 533         return @directories;
 534     } else {
 535         warn "unable to opendir $directoryname: $!";
 536         return;
 537     }
 538 }
 539
 540 =head3 getImageSets
 541
 542 returns: a listref of hashrefs. Each hash represents another collection of images.
 543
 544  { imagesetname => 'npl', # the name of the image set (npl is the original one)
 545          images => listref of image hashrefs
 546  }
 547
 548 each image is represented by a hashref like this:
 549
 550  { KohaImage     => 'npl/image.gif',
 551    StaffImageUrl => '/intranet-tmpl/prog/img/itemtypeimg/npl/image.gif',
 552    OpacImageURL  => '/opac-tmpl/prog/itemtypeimg/npl/image.gif'
 553    checked       => 0 or 1: was this the image passed to this method?
 554                     Note: I'd like to remove this somehow.
 555  }
 556
 557 =cut
 558
 559 sub getImageSets {
 560     my %params = @_;
 561     my $checked = $params{'checked'} || '';
 562
 563     my $paths = { staff => { filesystem => getitemtypeimagedir('intranet'),
 564                              url        => getitemtypeimagesrc('intranet'),
 565                         },
 566                   opac => { filesystem => getitemtypeimagedir('opac'),
 567                              url       => getitemtypeimagesrc('opac'),
 568                         }
 569                   };
 570
 571     my @imagesets = (); # list of hasrefs of image set data to pass to template
 572     my @subdirectories = _getSubdirectoryNames( $paths->{'staff'}{'filesystem'} );
 573 warn $paths->{'staff'}{'filesystem'};
 574     foreach my $imagesubdir ( @subdirectories ) {
 575         warn $imagesubdir;
 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 =head2 GetAuthValCode
 945
 946   $authvalcode = GetAuthValCode($kohafield,$frameworkcode);
 947
 948 =cut
 949
 950 sub GetAuthValCode {
 951         my ($kohafield,$fwcode) = @_;
 952         my $dbh = C4::Context->dbh;
 953         $fwcode='' unless $fwcode;
 954         my $sth = $dbh->prepare('select authorised_value from marc_subfield_structure where kohafield=? and frameworkcode=?');
 955         $sth->execute($kohafield,$fwcode);
 956         my ($authvalcode) = $sth->fetchrow_array;
 957         return $authvalcode;
 958 }
 959
 960 =head2 GetAuthValCodeFromField
 961
 962   $authvalcode = GetAuthValCodeFromField($field,$subfield,$frameworkcode);
 963
 964 C<$subfield> can be undefined
 965
 966 =cut
 967
 968 sub GetAuthValCodeFromField {
 969         my ($field,$subfield,$fwcode) = @_;
 970         my $dbh = C4::Context->dbh;
 971         $fwcode='' unless $fwcode;
 972         my $sth;
 973         if (defined $subfield) {
 974             $sth = $dbh->prepare('select authorised_value from marc_subfield_structure where tagfield=? and tagsubfield=? and frameworkcode=?');
 975             $sth->execute($field,$subfield,$fwcode);
 976         } else {
 977             $sth = $dbh->prepare('select authorised_value from marc_tag_structure where tagfield=? and frameworkcode=?');
 978             $sth->execute($field,$fwcode);
 979         }
 980         my ($authvalcode) = $sth->fetchrow_array;
 981         return $authvalcode;
 982 }
 983
 984 =head2 GetAuthorisedValues
 985
 986   $authvalues = GetAuthorisedValues([$category], [$selected]);
 987
 988 This function returns all authorised values from the'authorised_value' table in a reference to array of hashrefs.
 989
 990 C<$category> returns authorised values for just one category (optional).
 991
 992 C<$opac> If set to a true value, displays OPAC descriptions rather than normal ones when they exist.
 993
 994 =cut
 995
 996 sub GetAuthorisedValues {
 997     my ($category,$selected,$opac) = @_;
 998         my @results;
 999     my $dbh      = C4::Context->dbh;
1000     my $query    = "SELECT * FROM authorised_values";
1001     $query .= " WHERE category = '" . $category . "'" if $category;
1002     $query .= " ORDER BY category, lib, lib_opac";
1003     my $sth = $dbh->prepare($query);
1004     $sth->execute;
1005         while (my $data=$sth->fetchrow_hashref) {
1006             if ($selected && $selected eq $data->{'authorised_value'} ) {
1007                     $data->{'selected'} = 1;
1008             }
1009             if ($opac && $data->{'lib_opac'}) {
1010                 $data->{'lib'} = $data->{'lib_opac'};
1011             }
1012             push @results, $data;
1013         }
1014     #my $data = $sth->fetchall_arrayref({});
1015     return \@results; #$data;
1016 }
1017
1018 =head2 GetAuthorisedValueCategories
1019
1020   $auth_categories = GetAuthorisedValueCategories();
1021
1022 Return an arrayref of all of the available authorised
1023 value categories.
1024
1025 =cut
1026
1027 sub GetAuthorisedValueCategories {
1028     my $dbh = C4::Context->dbh;
1029     my $sth = $dbh->prepare("SELECT DISTINCT category FROM authorised_values ORDER BY category");
1030     $sth->execute;
1031     my @results;
1032     while (my $category = $sth->fetchrow_array) {
1033         push @results, $category;
1034     }
1035     return \@results;
1036 }
1037
1038 =head2 GetKohaAuthorisedValues
1039
1040 Takes $kohafield, $fwcode as parameters.
1041
1042 If $opac parameter is set to a true value, displays OPAC descriptions rather than normal ones when they exist.
1043
1044 Returns hashref of Code => description
1045
1046 Returns undef if no authorised value category is defined for the kohafield.
1047
1048 =cut
1049
1050 sub GetKohaAuthorisedValues {
1051   my ($kohafield,$fwcode,$opac) = @_;
1052   $fwcode='' unless $fwcode;
1053   my %values;
1054   my $dbh = C4::Context->dbh;
1055   my $avcode = GetAuthValCode($kohafield,$fwcode);
1056   if ($avcode) {
1057         my $sth = $dbh->prepare("select authorised_value, lib, lib_opac from authorised_values where category=? ");
1058         $sth->execute($avcode);
1059         while ( my ($val, $lib, $lib_opac) = $sth->fetchrow_array ) {
1060                 $values{$val} = ($opac && $lib_opac) ? $lib_opac : $lib;
1061         }
1062         return \%values;
1063   } else {
1064         return undef;
1065   }
1066 }
1067
1068 =head2 GetKohaAuthorisedValuesFromField
1069
1070 Takes $field, $subfield, $fwcode as parameters.
1071
1072 If $opac parameter is set to a true value, displays OPAC descriptions rather than normal ones when they exist.
1073 $subfield can be undefined
1074
1075 Returns hashref of Code => description
1076
1077 Returns undef if no authorised value category is defined for the given field and subfield
1078
1079 =cut
1080
1081 sub GetKohaAuthorisedValuesFromField {
1082   my ($field, $subfield, $fwcode,$opac) = @_;
1083   $fwcode='' unless $fwcode;
1084   my %values;
1085   my $dbh = C4::Context->dbh;
1086   my $avcode = GetAuthValCodeFromField($field, $subfield, $fwcode);
1087   if ($avcode) {
1088         my $sth = $dbh->prepare("select authorised_value, lib, lib_opac from authorised_values where category=? ");
1089         $sth->execute($avcode);
1090         while ( my ($val, $lib, $lib_opac) = $sth->fetchrow_array ) {
1091                 $values{$val} = ($opac && $lib_opac) ? $lib_opac : $lib;
1092         }
1093         return \%values;
1094   } else {
1095         return undef;
1096   }
1097 }
1098
1099 =head2 xml_escape
1100
1101   my $escaped_string = C4::Koha::xml_escape($string);
1102
1103 Convert &, <, >, ', and " in a string to XML entities
1104
1105 =cut
1106
1107 sub xml_escape {
1108     my $str = shift;
1109     return '' unless defined $str;
1110     $str =~ s/&/&amp;/g;
1111     $str =~ s/</&lt;/g;
1112     $str =~ s/>/&gt;/g;
1113     $str =~ s/'/&apos;/g;
1114     $str =~ s/"/&quot;/g;
1115     return $str;
1116 }
1117
1118 =head2 GetKohaAuthorisedValueLib
1119
1120 Takes $category, $authorised_value as parameters.
1121
1122 If $opac parameter is set to a true value, displays OPAC descriptions rather than normal ones when they exist.
1123
1124 Returns authorised value description
1125
1126 =cut
1127
1128 sub GetKohaAuthorisedValueLib {
1129   my ($category,$authorised_value,$opac) = @_;
1130   my $value;
1131   my $dbh = C4::Context->dbh;
1132   my $sth = $dbh->prepare("select lib, lib_opac from authorised_values where category=? and authorised_value=?");
1133   $sth->execute($category,$authorised_value);
1134   my $data = $sth->fetchrow_hashref;
1135   $value = ($opac && $$data{'lib_opac'}) ? $$data{'lib_opac'} : $$data{'lib'};
1136   return $value;
1137 }
1138
1139 =head2 display_marc_indicators
1140
1141   my $display_form = C4::Koha::display_marc_indicators($field);
1142
1143 C<$field> is a MARC::Field object
1144
1145 Generate a display form of the indicators of a variable
1146 MARC field, replacing any blanks with '#'.
1147
1148 =cut
1149
1150 sub display_marc_indicators {
1151     my $field = shift;
1152     my $indicators = '';
1153     if ($field->tag() >= 10) {
1154         $indicators = $field->indicator(1) . $field->indicator(2);
1155         $indicators =~ s/ /#/g;
1156     }
1157     return $indicators;
1158 }
1159
1160 sub GetNormalizedUPC {
1161  my ($record,$marcflavour) = @_;
1162     my (@fields,$upc);
1163
1164     if ($marcflavour eq 'MARC21') {
1165         @fields = $record->field('024');
1166         foreach my $field (@fields) {
1167             my $indicator = $field->indicator(1);
1168             my $upc = _normalize_match_point($field->subfield('a'));
1169             if ($indicator == 1 and $upc ne '') {
1170                 return $upc;
1171             }
1172         }
1173     }
1174     else { # assume unimarc if not marc21
1175         @fields = $record->field('072');
1176         foreach my $field (@fields) {
1177             my $upc = _normalize_match_point($field->subfield('a'));
1178             if ($upc ne '') {
1179                 return $upc;
1180             }
1181         }
1182     }
1183 }
1184
1185 # Normalizes and returns the first valid ISBN found in the record
1186 # ISBN13 are converted into ISBN10. This is required to get Amazon cover book.
1187 sub GetNormalizedISBN {
1188     my ($isbn,$record,$marcflavour) = @_;
1189     my @fields;
1190     if ($isbn) {
1191         # Koha attempts to store multiple ISBNs in biblioitems.isbn, separated by " | "
1192         # anything after " | " should be removed, along with the delimiter
1193         $isbn =~ s/(.*)( \| )(.*)/$1/;
1194         return _isbn_cleanup($isbn);
1195     }
1196     return undef unless $record;
1197
1198     if ($marcflavour eq 'MARC21') {
1199         @fields = $record->field('020');
1200         foreach my $field (@fields) {
1201             $isbn = $field->subfield('a');
1202             if ($isbn) {
1203                 return _isbn_cleanup($isbn);
1204             } else {
1205                 return undef;
1206             }
1207         }
1208     }
1209     else { # assume unimarc if not marc21
1210         @fields = $record->field('010');
1211         foreach my $field (@fields) {
1212             my $isbn = $field->subfield('a');
1213             if ($isbn) {
1214                 return _isbn_cleanup($isbn);
1215             } else {
1216                 return undef;
1217             }
1218         }
1219     }
1220
1221 }
1222
1223 sub GetNormalizedEAN {
1224     my ($record,$marcflavour) = @_;
1225     my (@fields,$ean);
1226
1227     if ($marcflavour eq 'MARC21') {
1228         @fields = $record->field('024');
1229         foreach my $field (@fields) {
1230             my $indicator = $field->indicator(1);
1231             $ean = _normalize_match_point($field->subfield('a'));
1232             if ($indicator == 3 and $ean ne '') {
1233                 return $ean;
1234             }
1235         }
1236     }
1237     else { # assume unimarc if not marc21
1238         @fields = $record->field('073');
1239         foreach my $field (@fields) {
1240             $ean = _normalize_match_point($field->subfield('a'));
1241             if ($ean ne '') {
1242                 return $ean;
1243             }
1244         }
1245     }
1246 }
1247 sub GetNormalizedOCLCNumber {
1248     my ($record,$marcflavour) = @_;
1249     my (@fields,$oclc);
1250
1251     if ($marcflavour eq 'MARC21') {
1252         @fields = $record->field('035');
1253         foreach my $field (@fields) {
1254             $oclc = $field->subfield('a');
1255             if ($oclc =~ /OCoLC/) {
1256                 $oclc =~ s/\(OCoLC\)//;
1257                 return $oclc;
1258             } else {
1259                 return undef;
1260             }
1261         }
1262     }
1263     else { # TODO: add UNIMARC fields
1264     }
1265 }
1266
1267 sub _normalize_match_point {
1268     my $match_point = shift;
1269     (my $normalized_match_point) = $match_point =~ /([\d-]*[X]*)/;
1270     $normalized_match_point =~ s/-//g;
1271
1272     return $normalized_match_point;
1273 }
1274
1275 sub _isbn_cleanup {
1276     my $isbn = Business::ISBN->new( $_[0] );
1277     if ( $isbn ) {
1278         $isbn = $isbn->as_isbn10 if $isbn->type eq 'ISBN13';
1279         if (defined $isbn) {
1280             return $isbn->as_string([]);
1281         }
1282     }
1283     return;
1284 }
1285
1286 1;
1287
1288 __END__
1289
1290 =head1 AUTHOR
1291
1292 Koha Team
1293
1294 =cut