C4/Koha.pm

   1 package C4::Koha;
   2
   3 # Copyright 2000-2002 Katipo Communications
   4 #
   5 # This file is part of Koha.
   6 #
   7 # Koha is free software; you can redistribute it and/or modify it under the
   8 # terms of the GNU General Public License as published by the Free Software
   9 # Foundation; either version 2 of the License, or (at your option) any later
  10 # version.
  11 #
  12 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
  13 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
  14 # A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
  15 #
  16 # You should have received a copy of the GNU General Public License along with
  17 # Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
  18 # Suite 330, Boston, MA  02111-1307 USA
  19
  20
  21 use strict;
  22 use C4::Context;
  23 use C4::Output;
  24
  25 use vars qw($VERSION @ISA @EXPORT $DEBUG);
  26
  27 BEGIN {
  28         $VERSION = 3.01;
  29         require Exporter;
  30         @ISA    = qw(Exporter);
  31         @EXPORT = qw(
  32                 &slashifyDate
  33                 &DisplayISBN
  34                 &subfield_is_koha_internal_p
  35                 &GetPrinters &GetPrinter
  36                 &GetItemTypes &getitemtypeinfo
  37                 &GetCcodes
  38                 &get_itemtypeinfos_of
  39                 &getframeworks &getframeworkinfo
  40                 &getauthtypes &getauthtype
  41                 &getallthemes
  42                 &getFacets
  43                 &displayServers
  44                 &getnbpages
  45                 &getitemtypeimagesrcfromurl
  46                 &get_infos_of
  47                 &get_notforloan_label_of
  48                 &getitemtypeimagedir
  49                 &getitemtypeimagesrc
  50                 &GetAuthorisedValues
  51                 &GetAuthorisedValueCategories
  52                 &GetKohaAuthorisedValues
  53                 &GetAuthValCode
  54                 &GetManagedTagSubfields
  55
  56                 $DEBUG
  57         );
  58         $DEBUG = 0;
  59 }
  60
  61 =head1 NAME
  62
  63     C4::Koha - Perl Module containing convenience functions for Koha scripts
  64
  65 =head1 SYNOPSIS
  66
  67   use C4::Koha;
  68
  69
  70 =head1 DESCRIPTION
  71
  72     Koha.pm provides many functions for Koha scripts.
  73
  74 =head1 FUNCTIONS
  75
  76 =over 2
  77
  78 =cut
  79 =head2 slashifyDate
  80
  81   $slash_date = &slashifyDate($dash_date);
  82
  83     Takes a string of the form "DD-MM-YYYY" (or anything separated by
  84     dashes), converts it to the form "YYYY/MM/DD", and returns the result.
  85
  86 =cut
  87
  88 sub slashifyDate {
  89
  90     # accepts a date of the form xx-xx-xx[xx] and returns it in the
  91     # form xx/xx/xx[xx]
  92     my @dateOut = split( '-', shift );
  93     return ("$dateOut[2]/$dateOut[1]/$dateOut[0]");
  94 }
  95
  96
  97 =head2 DisplayISBN
  98
  99     my $string = DisplayISBN( $isbn );
 100
 101 =cut
 102
 103 sub DisplayISBN {
 104     my ($isbn) = @_;
 105     if (length ($isbn)<13){
 106     my $seg1;
 107     if ( substr( $isbn, 0, 1 ) <= 7 ) {
 108         $seg1 = substr( $isbn, 0, 1 );
 109     }
 110     elsif ( substr( $isbn, 0, 2 ) <= 94 ) {
 111         $seg1 = substr( $isbn, 0, 2 );
 112     }
 113     elsif ( substr( $isbn, 0, 3 ) <= 995 ) {
 114         $seg1 = substr( $isbn, 0, 3 );
 115     }
 116     elsif ( substr( $isbn, 0, 4 ) <= 9989 ) {
 117         $seg1 = substr( $isbn, 0, 4 );
 118     }
 119     else {
 120         $seg1 = substr( $isbn, 0, 5 );
 121     }
 122     my $x = substr( $isbn, length($seg1) );
 123     my $seg2;
 124     if ( substr( $x, 0, 2 ) <= 19 ) {
 125
 126         # if(sTmp2 < 10) sTmp2 = "0" sTmp2;
 127         $seg2 = substr( $x, 0, 2 );
 128     }
 129     elsif ( substr( $x, 0, 3 ) <= 699 ) {
 130         $seg2 = substr( $x, 0, 3 );
 131     }
 132     elsif ( substr( $x, 0, 4 ) <= 8399 ) {
 133         $seg2 = substr( $x, 0, 4 );
 134     }
 135     elsif ( substr( $x, 0, 5 ) <= 89999 ) {
 136         $seg2 = substr( $x, 0, 5 );
 137     }
 138     elsif ( substr( $x, 0, 6 ) <= 9499999 ) {
 139         $seg2 = substr( $x, 0, 6 );
 140     }
 141     else {
 142         $seg2 = substr( $x, 0, 7 );
 143     }
 144     my $seg3 = substr( $x, length($seg2) );
 145     $seg3 = substr( $seg3, 0, length($seg3) - 1 );
 146     my $seg4 = substr( $x, -1, 1 );
 147     return "$seg1-$seg2-$seg3-$seg4";
 148     } else {
 149       my $seg1;
 150       $seg1 = substr( $isbn, 0, 3 );
 151       my $seg2;
 152       if ( substr( $isbn, 3, 1 ) <= 7 ) {
 153           $seg2 = substr( $isbn, 3, 1 );
 154       }
 155       elsif ( substr( $isbn, 3, 2 ) <= 94 ) {
 156           $seg2 = substr( $isbn, 3, 2 );
 157       }
 158       elsif ( substr( $isbn, 3, 3 ) <= 995 ) {
 159           $seg2 = substr( $isbn, 3, 3 );
 160       }
 161       elsif ( substr( $isbn, 3, 4 ) <= 9989 ) {
 162           $seg2 = substr( $isbn, 3, 4 );
 163       }
 164       else {
 165           $seg2 = substr( $isbn, 3, 5 );
 166       }
 167       my $x = substr( $isbn, length($seg2) +3);
 168       my $seg3;
 169       if ( substr( $x, 0, 2 ) <= 19 ) {
 170
 171           # if(sTmp2 < 10) sTmp2 = "0" sTmp2;
 172           $seg3 = substr( $x, 0, 2 );
 173       }
 174       elsif ( substr( $x, 0, 3 ) <= 699 ) {
 175           $seg3 = substr( $x, 0, 3 );
 176       }
 177       elsif ( substr( $x, 0, 4 ) <= 8399 ) {
 178           $seg3 = substr( $x, 0, 4 );
 179       }
 180       elsif ( substr( $x, 0, 5 ) <= 89999 ) {
 181           $seg3 = substr( $x, 0, 5 );
 182       }
 183       elsif ( substr( $x, 0, 6 ) <= 9499999 ) {
 184           $seg3 = substr( $x, 0, 6 );
 185       }
 186       else {
 187           $seg3 = substr( $x, 0, 7 );
 188       }
 189       my $seg4 = substr( $x, length($seg3) );
 190       $seg4 = substr( $seg4, 0, length($seg4) - 1 );
 191       my $seg5 = substr( $x, -1, 1 );
 192       return "$seg1-$seg2-$seg3-$seg4-$seg5";
 193     }
 194 }
 195
 196 # FIXME.. this should be moved to a MARC-specific module
 197 sub subfield_is_koha_internal_p ($) {
 198     my ($subfield) = @_;
 199
 200     # We could match on 'lib' and 'tab' (and 'mandatory', & more to come!)
 201     # But real MARC subfields are always single-character
 202     # so it really is safer just to check the length
 203
 204     return length $subfield != 1;
 205 }
 206
 207 =head2 GetItemTypes
 208
 209   $itemtypes = &GetItemTypes();
 210
 211 Returns information about existing itemtypes.
 212
 213 build a HTML select with the following code :
 214
 215 =head3 in PERL SCRIPT
 216
 217     my $itemtypes = GetItemTypes;
 218     my @itemtypesloop;
 219     foreach my $thisitemtype (sort keys %$itemtypes) {
 220         my $selected = 1 if $thisitemtype eq $itemtype;
 221         my %row =(value => $thisitemtype,
 222                     selected => $selected,
 223                     description => $itemtypes->{$thisitemtype}->{'description'},
 224                 );
 225         push @itemtypesloop, \%row;
 226     }
 227     $template->param(itemtypeloop => \@itemtypesloop);
 228
 229 =head3 in TEMPLATE
 230
 231     <form action='<!-- TMPL_VAR name="script_name" -->' method=post>
 232         <select name="itemtype">
 233             <option value="">Default</option>
 234         <!-- TMPL_LOOP name="itemtypeloop" -->
 235             <option value="<!-- TMPL_VAR name="value" -->" <!-- TMPL_IF name="selected" -->selected<!-- /TMPL_IF -->><!-- TMPL_VAR name="description" --></option>
 236         <!-- /TMPL_LOOP -->
 237         </select>
 238         <input type=text name=searchfield value="<!-- TMPL_VAR name="searchfield" -->">
 239         <input type="submit" value="OK" class="button">
 240     </form>
 241
 242 =cut
 243
 244 sub GetItemTypes {
 245
 246     # returns a reference to a hash of references to branches...
 247     my %itemtypes;
 248     my $dbh   = C4::Context->dbh;
 249     my $query = qq|
 250         SELECT *
 251         FROM   itemtypes
 252     |;
 253     my $sth = $dbh->prepare($query);
 254     $sth->execute;
 255     while ( my $IT = $sth->fetchrow_hashref ) {
 256         $itemtypes{ $IT->{'itemtype'} } = $IT;
 257     }
 258     return ( \%itemtypes );
 259 }
 260
 261 sub get_itemtypeinfos_of {
 262     my @itemtypes = @_;
 263
 264     my $query = '
 265 SELECT itemtype,
 266        description,
 267        imageurl,
 268        notforloan
 269   FROM itemtypes
 270   WHERE itemtype IN (' . join( ',', map( { "'" . $_ . "'" } @itemtypes ) ) . ')
 271 ';
 272
 273     return get_infos_of( $query, 'itemtype' );
 274 }
 275
 276 # this is temporary until we separate collection codes and item types
 277 sub GetCcodes {
 278     my $count = 0;
 279     my @results;
 280     my $dbh = C4::Context->dbh;
 281     my $sth =
 282       $dbh->prepare(
 283         "SELECT * FROM authorised_values ORDER BY authorised_value");
 284     $sth->execute;
 285     while ( my $data = $sth->fetchrow_hashref ) {
 286         if ( $data->{category} eq "CCODE" ) {
 287             $count++;
 288             $results[$count] = $data;
 289
 290             #warn "data: $data";
 291         }
 292     }
 293     $sth->finish;
 294     return ( $count, @results );
 295 }
 296
 297 =head2 getauthtypes
 298
 299   $authtypes = &getauthtypes();
 300
 301 Returns information about existing authtypes.
 302
 303 build a HTML select with the following code :
 304
 305 =head3 in PERL SCRIPT
 306
 307 my $authtypes = getauthtypes;
 308 my @authtypesloop;
 309 foreach my $thisauthtype (keys %$authtypes) {
 310     my $selected = 1 if $thisauthtype eq $authtype;
 311     my %row =(value => $thisauthtype,
 312                 selected => $selected,
 313                 authtypetext => $authtypes->{$thisauthtype}->{'authtypetext'},
 314             );
 315     push @authtypesloop, \%row;
 316 }
 317 $template->param(itemtypeloop => \@itemtypesloop);
 318
 319 =head3 in TEMPLATE
 320
 321 <form action='<!-- TMPL_VAR name="script_name" -->' method=post>
 322     <select name="authtype">
 323     <!-- TMPL_LOOP name="authtypeloop" -->
 324         <option value="<!-- TMPL_VAR name="value" -->" <!-- TMPL_IF name="selected" -->selected<!-- /TMPL_IF -->><!-- TMPL_VAR name="authtypetext" --></option>
 325     <!-- /TMPL_LOOP -->
 326     </select>
 327     <input type=text name=searchfield value="<!-- TMPL_VAR name="searchfield" -->">
 328     <input type="submit" value="OK" class="button">
 329 </form>
 330
 331
 332 =cut
 333
 334 sub getauthtypes {
 335
 336     # returns a reference to a hash of references to authtypes...
 337     my %authtypes;
 338     my $dbh = C4::Context->dbh;
 339     my $sth = $dbh->prepare("select * from auth_types order by authtypetext");
 340     $sth->execute;
 341     while ( my $IT = $sth->fetchrow_hashref ) {
 342         $authtypes{ $IT->{'authtypecode'} } = $IT;
 343     }
 344     return ( \%authtypes );
 345 }
 346
 347 sub getauthtype {
 348     my ($authtypecode) = @_;
 349
 350     # returns a reference to a hash of references to authtypes...
 351     my %authtypes;
 352     my $dbh = C4::Context->dbh;
 353     my $sth = $dbh->prepare("select * from auth_types where authtypecode=?");
 354     $sth->execute($authtypecode);
 355     my $res = $sth->fetchrow_hashref;
 356     return $res;
 357 }
 358
 359 =head2 getframework
 360
 361   $frameworks = &getframework();
 362
 363 Returns information about existing frameworks
 364
 365 build a HTML select with the following code :
 366
 367 =head3 in PERL SCRIPT
 368
 369 my $frameworks = frameworks();
 370 my @frameworkloop;
 371 foreach my $thisframework (keys %$frameworks) {
 372     my $selected = 1 if $thisframework eq $frameworkcode;
 373     my %row =(value => $thisframework,
 374                 selected => $selected,
 375                 description => $frameworks->{$thisframework}->{'frameworktext'},
 376             );
 377     push @frameworksloop, \%row;
 378 }
 379 $template->param(frameworkloop => \@frameworksloop);
 380
 381 =head3 in TEMPLATE
 382
 383 <form action='<!-- TMPL_VAR name="script_name" -->' method=post>
 384     <select name="frameworkcode">
 385         <option value="">Default</option>
 386     <!-- TMPL_LOOP name="frameworkloop" -->
 387         <option value="<!-- TMPL_VAR name="value" -->" <!-- TMPL_IF name="selected" -->selected<!-- /TMPL_IF -->><!-- TMPL_VAR name="frameworktext" --></option>
 388     <!-- /TMPL_LOOP -->
 389     </select>
 390     <input type=text name=searchfield value="<!-- TMPL_VAR name="searchfield" -->">
 391     <input type="submit" value="OK" class="button">
 392 </form>
 393
 394
 395 =cut
 396
 397 sub getframeworks {
 398
 399     # returns a reference to a hash of references to branches...
 400     my %itemtypes;
 401     my $dbh = C4::Context->dbh;
 402     my $sth = $dbh->prepare("select * from biblio_framework");
 403     $sth->execute;
 404     while ( my $IT = $sth->fetchrow_hashref ) {
 405         $itemtypes{ $IT->{'frameworkcode'} } = $IT;
 406     }
 407     return ( \%itemtypes );
 408 }
 409
 410 =head2 getframeworkinfo
 411
 412   $frameworkinfo = &getframeworkinfo($frameworkcode);
 413
 414 Returns information about an frameworkcode.
 415
 416 =cut
 417
 418 sub getframeworkinfo {
 419     my ($frameworkcode) = @_;
 420     my $dbh             = C4::Context->dbh;
 421     my $sth             =
 422       $dbh->prepare("select * from biblio_framework where frameworkcode=?");
 423     $sth->execute($frameworkcode);
 424     my $res = $sth->fetchrow_hashref;
 425     return $res;
 426 }
 427
 428 =head2 getitemtypeinfo
 429
 430   $itemtype = &getitemtype($itemtype);
 431
 432 Returns information about an itemtype.
 433
 434 =cut
 435
 436 sub getitemtypeinfo {
 437     my ($itemtype) = @_;
 438     my $dbh        = C4::Context->dbh;
 439     my $sth        = $dbh->prepare("select * from itemtypes where itemtype=?");
 440     $sth->execute($itemtype);
 441     my $res = $sth->fetchrow_hashref;
 442
 443     $res->{imageurl} = getitemtypeimagesrcfromurl( $res->{imageurl} );
 444
 445     return $res;
 446 }
 447
 448 sub getitemtypeimagesrcfromurl {
 449     my ($imageurl) = @_;
 450
 451     if ( defined $imageurl and $imageurl !~ m/^http/ ) {
 452         $imageurl = getitemtypeimagesrc() . '/' . $imageurl;
 453     }
 454
 455     return $imageurl;
 456 }
 457
 458 sub getitemtypeimagedir {
 459         my $src = shift;
 460         if ($src eq 'intranet') {
 461                 return C4::Context->config('intrahtdocs') . '/' .C4::Context->preference('template') . '/img/itemtypeimg';
 462         }
 463         else {
 464                 return C4::Context->config('opachtdocs') . '/' . C4::Context->preference('template') . '/itemtypeimg';
 465         }
 466 }
 467
 468 sub getitemtypeimagesrc {
 469          my $src = shift;
 470         if ($src eq 'intranet') {
 471                 return '/intranet-tmpl' . '/' . C4::Context->preference('template') . '/img/itemtypeimg';
 472         }
 473         else {
 474                 return '/opac-tmpl' . '/' . C4::Context->preference('template') . '/itemtypeimg';
 475         }
 476 }
 477
 478 =head3 _getImagesFromDirectory
 479
 480   Find all of the image files in a directory in the filesystem
 481
 482   parameters:
 483     a directory name
 484
 485   returns: a list of images in that directory.
 486
 487   Notes: this does not traverse into subdirectories. See
 488       _getSubdirectoryNames for help with that.
 489     Images are assumed to be files with .gif or .png file extensions.
 490     The image names returned do not have the directory name on them.
 491
 492 =cut
 493
 494 sub _getImagesFromDirectory {
 495     my $directoryname = shift;
 496     return unless defined $directoryname;
 497     return unless -d $directoryname;
 498
 499     if ( opendir ( my $dh, $directoryname ) ) {
 500         my @images = grep { /\.(gif|png)$/i } readdir( $dh );
 501         closedir $dh;
 502         return @images;
 503     } else {
 504         warn "unable to opendir $directoryname: $!";
 505         return;
 506     }
 507 }
 508
 509 =head3 _getSubdirectoryNames
 510
 511   Find all of the directories in a directory in the filesystem
 512
 513   parameters:
 514     a directory name
 515
 516   returns: a list of subdirectories in that directory.
 517
 518   Notes: this does not traverse into subdirectories. Only the first
 519       level of subdirectories are returned.
 520     The directory names returned don't have the parent directory name
 521       on them.
 522
 523 =cut
 524
 525 sub _getSubdirectoryNames {
 526     my $directoryname = shift;
 527     return unless defined $directoryname;
 528     return unless -d $directoryname;
 529
 530     if ( opendir ( my $dh, $directoryname ) ) {
 531         my @directories = grep { -d File::Spec->catfile( $directoryname, $_ ) && ! ( /^\./ ) } readdir( $dh );
 532         closedir $dh;
 533         return @directories;
 534     } else {
 535         warn "unable to opendir $directoryname: $!";
 536         return;
 537     }
 538 }
 539
 540 =head3 getImageSets
 541
 542   returns: a listref of hashrefs. Each hash represents another collection of images.
 543            { imagesetname => 'npl', # the name of the image set (npl is the original one)
 544              images => listref of image hashrefs
 545            }
 546
 547     each image is represented by a hashref like this:
 548       { KohaImage     => 'npl/image.gif',
 549         StaffImageUrl => '/intranet-tmpl/prog/img/itemtypeimg/npl/image.gif',
 550         OpacImageURL  => '/opac-tmpl/prog/itemtypeimg/npl/image.gif'
 551         checked       => 0 or 1: was this the image passed to this method?
 552                          Note: I'd like to remove this somehow.
 553       }
 554
 555 =cut
 556
 557 sub getImageSets {
 558     my %params = @_;
 559     my $checked = $params{'checked'} || '';
 560
 561     my $paths = { staff => { filesystem => getitemtypeimagedir('intranet'),
 562                              url        => getitemtypeimagesrc('intranet'),
 563                         },
 564                   opac => { filesystem => getitemtypeimagedir('opac'),
 565                              url       => getitemtypeimagesrc('opac'),
 566                         }
 567                   };
 568
 569     my @imagesets = (); # list of hasrefs of image set data to pass to template
 570     my @subdirectories = _getSubdirectoryNames( $paths->{'staff'}{'filesystem'} );
 571
 572     foreach my $imagesubdir ( @subdirectories ) {
 573         my @imagelist     = (); # hashrefs of image info
 574         my @imagenames = _getImagesFromDirectory( File::Spec->catfile( $paths->{'staff'}{'filesystem'}, $imagesubdir ) );
 575         foreach my $thisimage ( @imagenames ) {
 576             push( @imagelist,
 577                   { KohaImage     => "$imagesubdir/$thisimage",
 578                     StaffImageUrl => join( '/', $paths->{'staff'}{'url'}, $imagesubdir, $thisimage ),
 579                     OpacImageUrl  => join( '/', $paths->{'opac'}{'url'}, $imagesubdir, $thisimage ),
 580                     checked       => "$imagesubdir/$thisimage" eq $checked ? 1 : 0,
 581                }
 582              );
 583         }
 584         push @imagesets, { imagesetname => $imagesubdir,
 585                            images       => \@imagelist };
 586
 587     }
 588     return \@imagesets;
 589 }
 590
 591 =head2 GetPrinters
 592
 593   $printers = &GetPrinters();
 594   @queues = keys %$printers;
 595
 596 Returns information about existing printer queues.
 597
 598 C<$printers> is a reference-to-hash whose keys are the print queues
 599 defined in the printers table of the Koha database. The values are
 600 references-to-hash, whose keys are the fields in the printers table.
 601
 602 =cut
 603
 604 sub GetPrinters {
 605     my %printers;
 606     my $dbh = C4::Context->dbh;
 607     my $sth = $dbh->prepare("select * from printers");
 608     $sth->execute;
 609     while ( my $printer = $sth->fetchrow_hashref ) {
 610         $printers{ $printer->{'printqueue'} } = $printer;
 611     }
 612     return ( \%printers );
 613 }
 614
 615 =head2 GetPrinter
 616
 617 $printer = GetPrinter( $query, $printers );
 618
 619 =cut
 620
 621 sub GetPrinter ($$) {
 622     my ( $query, $printers ) = @_;    # get printer for this query from printers
 623     my $printer = $query->param('printer');
 624     my %cookie = $query->cookie('userenv');
 625     ($printer) || ( $printer = $cookie{'printer'} ) || ( $printer = '' );
 626     ( $printers->{$printer} ) || ( $printer = ( keys %$printers )[0] );
 627     return $printer;
 628 }
 629
 630 =item getnbpages
 631
 632 Returns the number of pages to display in a pagination bar, given the number
 633 of items and the number of items per page.
 634
 635 =cut
 636
 637 sub getnbpages {
 638     my ( $nb_items, $nb_items_per_page ) = @_;
 639
 640     return int( ( $nb_items - 1 ) / $nb_items_per_page ) + 1;
 641 }
 642
 643 =item getallthemes
 644
 645   (@themes) = &getallthemes('opac');
 646   (@themes) = &getallthemes('intranet');
 647
 648 Returns an array of all available themes.
 649
 650 =cut
 651
 652 sub getallthemes {
 653     my $type = shift;
 654     my $htdocs;
 655     my @themes;
 656     if ( $type eq 'intranet' ) {
 657         $htdocs = C4::Context->config('intrahtdocs');
 658     }
 659     else {
 660         $htdocs = C4::Context->config('opachtdocs');
 661     }
 662     opendir D, "$htdocs";
 663     my @dirlist = readdir D;
 664     foreach my $directory (@dirlist) {
 665         -d "$htdocs/$directory/en" and push @themes, $directory;
 666     }
 667     return @themes;
 668 }
 669
 670 sub getFacets {
 671     my $facets;
 672     if ( C4::Context->preference("marcflavour") eq "UNIMARC" ) {
 673         $facets = [
 674             {
 675                 link_value  => 'su-to',
 676                 label_value => 'Topics',
 677                 tags        =>
 678                   [ '600', '601', '602', '603', '604', '605', '606', '610' ],
 679                 subfield => 'a',
 680             },
 681             {
 682                 link_value  => 'su-geo',
 683                 label_value => 'Places',
 684                 tags        => ['651'],
 685                 subfield    => 'a',
 686             },
 687             {
 688                 link_value  => 'su-ut',
 689                 label_value => 'Titles',
 690                 tags        => [ '500', '501', '502', '503', '504', ],
 691                 subfield    => 'a',
 692             },
 693             {
 694                 link_value  => 'au',
 695                 label_value => 'Authors',
 696                 tags        => [ '700', '701', '702', ],
 697                 subfield    => 'a',
 698             },
 699             {
 700                 link_value  => 'se',
 701                 label_value => 'Series',
 702                 tags        => ['225'],
 703                 subfield    => 'a',
 704             },
 705             ];
 706
 707             my $library_facet;
 708
 709             $library_facet = {
 710                 link_value  => 'branch',
 711                 label_value => 'Libraries',
 712                 tags        => [ '995', ],
 713                 subfield    => 'b',
 714                 expanded    => '1',
 715             };
 716             push @$facets, $library_facet unless C4::Context->preference("singleBranchMode");
 717     }
 718     else {
 719         $facets = [
 720             {
 721                 link_value  => 'su-to',
 722                 label_value => 'Topics',
 723                 tags        => ['650'],
 724                 subfield    => 'a',
 725             },
 726
 727             #        {
 728             #        link_value => 'su-na',
 729             #        label_value => 'People and Organizations',
 730             #        tags => ['600', '610', '611'],
 731             #        subfield => 'a',
 732             #        },
 733             {
 734                 link_value  => 'su-geo',
 735                 label_value => 'Places',
 736                 tags        => ['651'],
 737                 subfield    => 'a',
 738             },
 739             {
 740                 link_value  => 'su-ut',
 741                 label_value => 'Titles',
 742                 tags        => ['630'],
 743                 subfield    => 'a',
 744             },
 745             {
 746                 link_value  => 'au',
 747                 label_value => 'Authors',
 748                 tags        => [ '100', '110', '700', ],
 749                 subfield    => 'a',
 750             },
 751             {
 752                 link_value  => 'se',
 753                 label_value => 'Series',
 754                 tags        => [ '440', '490', ],
 755                 subfield    => 'a',
 756             },
 757             ];
 758             my $library_facet;
 759             $library_facet = {
 760                 link_value  => 'branch',
 761                 label_value => 'Libraries',
 762                 tags        => [ '952', ],
 763                 subfield    => 'b',
 764                 expanded    => '1',
 765             };
 766             push @$facets, $library_facet unless C4::Context->preference("singleBranchMode");
 767     }
 768     return $facets;
 769 }
 770
 771 =head2 get_infos_of
 772
 773 Return a href where a key is associated to a href. You give a query, the
 774 name of the key among the fields returned by the query. If you also give as
 775 third argument the name of the value, the function returns a href of scalar.
 776
 777   my $query = '
 778 SELECT itemnumber,
 779        notforloan,
 780        barcode
 781   FROM items
 782 ';
 783
 784   # generic href of any information on the item, href of href.
 785   my $iteminfos_of = get_infos_of($query, 'itemnumber');
 786   print $iteminfos_of->{$itemnumber}{barcode};
 787
 788   # specific information, href of scalar
 789   my $barcode_of_item = get_infos_of($query, 'itemnumber', 'barcode');
 790   print $barcode_of_item->{$itemnumber};
 791
 792 =cut
 793
 794 sub get_infos_of {
 795     my ( $query, $key_name, $value_name ) = @_;
 796
 797     my $dbh = C4::Context->dbh;
 798
 799     my $sth = $dbh->prepare($query);
 800     $sth->execute();
 801
 802     my %infos_of;
 803     while ( my $row = $sth->fetchrow_hashref ) {
 804         if ( defined $value_name ) {
 805             $infos_of{ $row->{$key_name} } = $row->{$value_name};
 806         }
 807         else {
 808             $infos_of{ $row->{$key_name} } = $row;
 809         }
 810     }
 811     $sth->finish;
 812
 813     return \%infos_of;
 814 }
 815
 816 =head2 get_notforloan_label_of
 817
 818   my $notforloan_label_of = get_notforloan_label_of();
 819
 820 Each authorised value of notforloan (information available in items and
 821 itemtypes) is link to a single label.
 822
 823 Returns a href where keys are authorised values and values are corresponding
 824 labels.
 825
 826   foreach my $authorised_value (keys %{$notforloan_label_of}) {
 827     printf(
 828         "authorised_value: %s => %s\n",
 829         $authorised_value,
 830         $notforloan_label_of->{$authorised_value}
 831     );
 832   }
 833
 834 =cut
 835
 836 # FIXME - why not use GetAuthorisedValues ??
 837 #
 838 sub get_notforloan_label_of {
 839     my $dbh = C4::Context->dbh;
 840
 841     my $query = '
 842 SELECT authorised_value
 843   FROM marc_subfield_structure
 844   WHERE kohafield = \'items.notforloan\'
 845   LIMIT 0, 1
 846 ';
 847     my $sth = $dbh->prepare($query);
 848     $sth->execute();
 849     my ($statuscode) = $sth->fetchrow_array();
 850
 851     $query = '
 852 SELECT lib,
 853        authorised_value
 854   FROM authorised_values
 855   WHERE category = ?
 856 ';
 857     $sth = $dbh->prepare($query);
 858     $sth->execute($statuscode);
 859     my %notforloan_label_of;
 860     while ( my $row = $sth->fetchrow_hashref ) {
 861         $notforloan_label_of{ $row->{authorised_value} } = $row->{lib};
 862     }
 863     $sth->finish;
 864
 865     return \%notforloan_label_of;
 866 }
 867
 868 sub displayServers {
 869     my ( $position, $type ) = @_;
 870     my $dbh    = C4::Context->dbh;
 871     my $strsth = "SELECT * FROM z3950servers where 1";
 872     $strsth .= " AND position=\"$position\"" if ($position);
 873     $strsth .= " AND type=\"$type\""         if ($type);
 874     my $rq = $dbh->prepare($strsth);
 875     $rq->execute;
 876     my @primaryserverloop;
 877
 878     while ( my $data = $rq->fetchrow_hashref ) {
 879         my %cell;
 880         $cell{label} = $data->{'description'};
 881         $cell{id}    = $data->{'name'};
 882         $cell{value} =
 883             $data->{host}
 884           . ( $data->{port} ? ":" . $data->{port} : "" ) . "/"
 885           . $data->{database}
 886           if ( $data->{host} );
 887         $cell{checked} = $data->{checked};
 888         push @primaryserverloop,
 889           {
 890             label => $data->{description},
 891             id    => $data->{name},
 892             name  => "server",
 893             value => $data->{host} . ":"
 894               . $data->{port} . "/"
 895               . $data->{database},
 896             encoding   => ($data->{encoding}?$data->{encoding}:"iso-5426"),
 897             checked    => "checked",
 898             icon       => $data->{icon},
 899             zed        => $data->{type} eq 'zed',
 900             opensearch => $data->{type} eq 'opensearch'
 901           };
 902     }
 903     return \@primaryserverloop;
 904 }
 905
 906 sub displaySecondaryServers {
 907
 908 #       my $secondary_servers_loop = [
 909 #               { inner_sup_servers_loop => [
 910 #               {label => "Google", id=>"GOOG", value=>"google",icon => "google.ico",opensearch => "1"},
 911 #               {label => "Yahoo", id=>"YAH", value=>"yahoo", icon =>"yahoo.ico", zed => "1"},
 912 #               {label => "Worldcat", id=>"WCT", value=>"worldcat", icon => "worldcat.gif", zed => "1"},
 913 #               {label => "Library of Congress", id=>"LOC", name=> "server", value=>"z3950.loc.gov:7090/Voyager", icon =>"loc.ico", zed => "1"},
 914 #       ],
 915 #       },
 916 #       ];
 917     return;    #$secondary_servers_loop;
 918 }
 919
 920 =head2 GetAuthValCode
 921
 922 $authvalcode = GetAuthValCode($kohafield,$frameworkcode);
 923
 924 =cut
 925
 926 sub GetAuthValCode {
 927         my ($kohafield,$fwcode) = @_;
 928         my $dbh = C4::Context->dbh;
 929         $fwcode='' unless $fwcode;
 930         my $sth = $dbh->prepare('select authorised_value from marc_subfield_structure where kohafield=? and frameworkcode=?');
 931         $sth->execute($kohafield,$fwcode);
 932         my ($authvalcode) = $sth->fetchrow_array;
 933         return $authvalcode;
 934 }
 935
 936 =head2 GetAuthorisedValues
 937
 938 $authvalues = GetAuthorisedValues($category);
 939
 940 this function get all authorised values from 'authosied_value' table into a reference to array which
 941 each value containt an hashref.
 942
 943 Set C<$category> on input args if you want to limits your query to this one. This params is not mandatory.
 944
 945 =cut
 946
 947 sub GetAuthorisedValues {
 948     my ($category,$selected) = @_;
 949         my $count = 0;
 950         my @results;
 951     my $dbh      = C4::Context->dbh;
 952     my $query    = "SELECT * FROM authorised_values";
 953     $query .= " WHERE category = '" . $category . "'" if $category;
 954
 955     my $sth = $dbh->prepare($query);
 956     $sth->execute;
 957         while (my $data=$sth->fetchrow_hashref) {
 958                 if ($selected eq $data->{'authorised_value'} ) {
 959                         $data->{'selected'} = 1;
 960                 }
 961                 $results[$count] = $data;
 962                 $count++;
 963         }
 964     #my $data = $sth->fetchall_arrayref({});
 965     return \@results; #$data;
 966 }
 967
 968 =head2 GetAuthorisedValueCategories
 969
 970 $auth_categories = GetAuthorisedValueCategories();
 971
 972 Return an arrayref of all of the available authorised
 973 value categories.
 974
 975 =cut
 976
 977 sub GetAuthorisedValueCategories {
 978     my $dbh = C4::Context->dbh;
 979     my $sth = $dbh->prepare("SELECT DISTINCT category FROM authorised_values ORDER BY category");
 980     $sth->execute;
 981     my @results;
 982     while (my $category = $sth->fetchrow_array) {
 983         push @results, $category;
 984     }
 985     return \@results;
 986 }
 987
 988 =head2 GetKohaAuthorisedValues
 989
 990         Takes $kohafield, $fwcode as parameters.
 991         Returns hashref of Code => description
 992         Returns undef
 993           if no authorised value category is defined for the kohafield.
 994
 995 =cut
 996
 997 sub GetKohaAuthorisedValues {
 998   my ($kohafield,$fwcode,$codedvalue) = @_;
 999   $fwcode='' unless $fwcode;
1000   my %values;
1001   my $dbh = C4::Context->dbh;
1002   my $avcode = GetAuthValCode($kohafield,$fwcode);
1003   if ($avcode) {
1004         my $sth = $dbh->prepare("select authorised_value, lib from authorised_values where category=? ");
1005         $sth->execute($avcode);
1006         while ( my ($val, $lib) = $sth->fetchrow_array ) {
1007                 $values{$val}= $lib;
1008         }
1009         return \%values;
1010   } else {
1011         return undef;
1012   }
1013 }
1014
1015 =head2 GetManagedTagSubfields
1016
1017 =over 4
1018
1019 $res = GetManagedTagSubfields();
1020
1021 =back
1022
1023 Returns a reference to a big hash of hash, with the Marc structure fro the given frameworkcode
1024
1025 NOTE: This function is used only by the (incomplete) bulk editing feature.  Since
1026 that feature currently does not deal with items and biblioitems changes
1027 correctly, those tags are specifically excluded from the list prepared
1028 by this function.
1029
1030 For future reference, if a bulk item editing feature is implemented at some point, it
1031 needs some design thought -- for example, circulation status fields should not
1032 be changed willy-nilly.
1033
1034 =cut
1035
1036 sub GetManagedTagSubfields{
1037   my $dbh=C4::Context->dbh;
1038   my $rq=$dbh->prepare(qq|
1039 SELECT
1040   DISTINCT CONCAT( marc_subfield_structure.tagfield, tagsubfield ) AS tagsubfield,
1041   marc_subfield_structure.liblibrarian as subfielddesc,
1042   marc_tag_structure.liblibrarian as tagdesc
1043 FROM marc_subfield_structure
1044   LEFT JOIN marc_tag_structure
1045     ON marc_tag_structure.tagfield = marc_subfield_structure.tagfield
1046     AND marc_tag_structure.frameworkcode = marc_subfield_structure.frameworkcode
1047 WHERE marc_subfield_structure.tab>=0
1048 AND marc_tag_structure.tagfield NOT IN (SELECT tagfield FROM marc_subfield_structure WHERE kohafield like 'items.%')
1049 AND marc_tag_structure.tagfield NOT IN (SELECT tagfield FROM marc_subfield_structure WHERE kohafield = 'biblioitems.itemtype')
1050 AND marc_subfield_structure.kohafield <> 'biblio.biblionumber'
1051 AND marc_subfield_structure.kohafield <>  'biblioitems.biblioitemnumber'
1052 ORDER BY marc_subfield_structure.tagfield, tagsubfield|);
1053   $rq->execute;
1054   my $data=$rq->fetchall_arrayref({});
1055   return $data;
1056 }
1057
1058 =head2 display_marc_indicators
1059
1060 =over 4
1061
1062 # field is a MARC::Field object
1063 my $display_form = C4::Koha::display_marc_indicators($field);
1064
1065 =back
1066
1067 Generate a display form of the indicators of a variable
1068 MARC field, replacing any blanks with '#'.
1069
1070 =cut
1071
1072 sub display_marc_indicators {
1073     my $field = shift;
1074     my $indicators = '';
1075     if ($field->tag() >= 10) {
1076         $indicators = $field->indicator(1) . $field->indicator(2);
1077         $indicators =~ s/ /#/g;
1078     }
1079     return $indicators;
1080 }
1081
1082 1;
1083
1084 __END__
1085
1086 =head1 AUTHOR
1087
1088 Koha Team
1089
1090 =cut