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