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