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