C4/Koha.pm

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