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