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