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 $placeholders = join( ', ', map { '?' } @itemtypes );
 265     my $query = <<"END_SQL";
 266 SELECT itemtype,
 267        description,
 268        imageurl,
 269        notforloan
 270   FROM itemtypes
 271   WHERE itemtype IN ( $placeholders )
 272 END_SQL
 273
 274     return get_infos_of( $query, 'itemtype', undef, \@itemtypes );
 275 }
 276
 277 # this is temporary until we separate collection codes and item types
 278 sub GetCcodes {
 279     my $count = 0;
 280     my @results;
 281     my $dbh = C4::Context->dbh;
 282     my $sth =
 283       $dbh->prepare(
 284         "SELECT * FROM authorised_values ORDER BY authorised_value");
 285     $sth->execute;
 286     while ( my $data = $sth->fetchrow_hashref ) {
 287         if ( $data->{category} eq "CCODE" ) {
 288             $count++;
 289             $results[$count] = $data;
 290
 291             #warn "data: $data";
 292         }
 293     }
 294     $sth->finish;
 295     return ( $count, @results );
 296 }
 297
 298 =head2 getauthtypes
 299
 300   $authtypes = &getauthtypes();
 301
 302 Returns information about existing authtypes.
 303
 304 build a HTML select with the following code :
 305
 306 =head3 in PERL SCRIPT
 307
 308 my $authtypes = getauthtypes;
 309 my @authtypesloop;
 310 foreach my $thisauthtype (keys %$authtypes) {
 311     my $selected = 1 if $thisauthtype eq $authtype;
 312     my %row =(value => $thisauthtype,
 313                 selected => $selected,
 314                 authtypetext => $authtypes->{$thisauthtype}->{'authtypetext'},
 315             );
 316     push @authtypesloop, \%row;
 317 }
 318 $template->param(itemtypeloop => \@itemtypesloop);
 319
 320 =head3 in TEMPLATE
 321
 322 <form action='<!-- TMPL_VAR name="script_name" -->' method=post>
 323     <select name="authtype">
 324     <!-- TMPL_LOOP name="authtypeloop" -->
 325         <option value="<!-- TMPL_VAR name="value" -->" <!-- TMPL_IF name="selected" -->selected<!-- /TMPL_IF -->><!-- TMPL_VAR name="authtypetext" --></option>
 326     <!-- /TMPL_LOOP -->
 327     </select>
 328     <input type=text name=searchfield value="<!-- TMPL_VAR name="searchfield" -->">
 329     <input type="submit" value="OK" class="button">
 330 </form>
 331
 332
 333 =cut
 334
 335 sub getauthtypes {
 336
 337     # returns a reference to a hash of references to authtypes...
 338     my %authtypes;
 339     my $dbh = C4::Context->dbh;
 340     my $sth = $dbh->prepare("select * from auth_types order by authtypetext");
 341     $sth->execute;
 342     while ( my $IT = $sth->fetchrow_hashref ) {
 343         $authtypes{ $IT->{'authtypecode'} } = $IT;
 344     }
 345     return ( \%authtypes );
 346 }
 347
 348 sub getauthtype {
 349     my ($authtypecode) = @_;
 350
 351     # returns a reference to a hash of references to authtypes...
 352     my %authtypes;
 353     my $dbh = C4::Context->dbh;
 354     my $sth = $dbh->prepare("select * from auth_types where authtypecode=?");
 355     $sth->execute($authtypecode);
 356     my $res = $sth->fetchrow_hashref;
 357     return $res;
 358 }
 359
 360 =head2 getframework
 361
 362   $frameworks = &getframework();
 363
 364 Returns information about existing frameworks
 365
 366 build a HTML select with the following code :
 367
 368 =head3 in PERL SCRIPT
 369
 370 my $frameworks = frameworks();
 371 my @frameworkloop;
 372 foreach my $thisframework (keys %$frameworks) {
 373     my $selected = 1 if $thisframework eq $frameworkcode;
 374     my %row =(value => $thisframework,
 375                 selected => $selected,
 376                 description => $frameworks->{$thisframework}->{'frameworktext'},
 377             );
 378     push @frameworksloop, \%row;
 379 }
 380 $template->param(frameworkloop => \@frameworksloop);
 381
 382 =head3 in TEMPLATE
 383
 384 <form action='<!-- TMPL_VAR name="script_name" -->' method=post>
 385     <select name="frameworkcode">
 386         <option value="">Default</option>
 387     <!-- TMPL_LOOP name="frameworkloop" -->
 388         <option value="<!-- TMPL_VAR name="value" -->" <!-- TMPL_IF name="selected" -->selected<!-- /TMPL_IF -->><!-- TMPL_VAR name="frameworktext" --></option>
 389     <!-- /TMPL_LOOP -->
 390     </select>
 391     <input type=text name=searchfield value="<!-- TMPL_VAR name="searchfield" -->">
 392     <input type="submit" value="OK" class="button">
 393 </form>
 394
 395
 396 =cut
 397
 398 sub getframeworks {
 399
 400     # returns a reference to a hash of references to branches...
 401     my %itemtypes;
 402     my $dbh = C4::Context->dbh;
 403     my $sth = $dbh->prepare("select * from biblio_framework");
 404     $sth->execute;
 405     while ( my $IT = $sth->fetchrow_hashref ) {
 406         $itemtypes{ $IT->{'frameworkcode'} } = $IT;
 407     }
 408     return ( \%itemtypes );
 409 }
 410
 411 =head2 getframeworkinfo
 412
 413   $frameworkinfo = &getframeworkinfo($frameworkcode);
 414
 415 Returns information about an frameworkcode.
 416
 417 =cut
 418
 419 sub getframeworkinfo {
 420     my ($frameworkcode) = @_;
 421     my $dbh             = C4::Context->dbh;
 422     my $sth             =
 423       $dbh->prepare("select * from biblio_framework where frameworkcode=?");
 424     $sth->execute($frameworkcode);
 425     my $res = $sth->fetchrow_hashref;
 426     return $res;
 427 }
 428
 429 =head2 getitemtypeinfo
 430
 431   $itemtype = &getitemtype($itemtype);
 432
 433 Returns information about an itemtype.
 434
 435 =cut
 436
 437 sub getitemtypeinfo {
 438     my ($itemtype) = @_;
 439     my $dbh        = C4::Context->dbh;
 440     my $sth        = $dbh->prepare("select * from itemtypes where itemtype=?");
 441     $sth->execute($itemtype);
 442     my $res = $sth->fetchrow_hashref;
 443
 444     $res->{imageurl} = getitemtypeimagesrcfromurl( $res->{imageurl} );
 445
 446     return $res;
 447 }
 448
 449 sub getitemtypeimagesrcfromurl {
 450     my ($imageurl) = @_;
 451
 452     if ( defined $imageurl and $imageurl !~ m/^http/ ) {
 453         $imageurl = getitemtypeimagesrc() . '/' . $imageurl;
 454     }
 455
 456     return $imageurl;
 457 }
 458
 459 =head2 getitemtypeimagedir
 460
 461 =over
 462
 463 =item 4
 464
 465   my $directory = getitemtypeimagedir( 'opac' );
 466
 467 pass in 'opac' or 'intranet'. Defaults to 'opac'.
 468
 469 returns the full path to the appropriate directory containing images.
 470
 471 =back
 472
 473 =cut
 474
 475 sub getitemtypeimagedir {
 476         my $src = shift;
 477         $src = 'opac' unless defined $src;
 478
 479         if ($src eq 'intranet') {
 480                 return C4::Context->config('intrahtdocs') . '/' .C4::Context->preference('template') . '/img/itemtypeimg';
 481         }
 482         else {
 483                 return C4::Context->config('opachtdocs') . '/' . C4::Context->preference('template') . '/itemtypeimg';
 484         }
 485 }
 486
 487 sub getitemtypeimagesrc {
 488          my $src = shift;
 489         if ($src eq 'intranet') {
 490                 return '/intranet-tmpl' . '/' . C4::Context->preference('template') . '/img/itemtypeimg';
 491         }
 492         else {
 493                 return '/opac-tmpl' . '/' . C4::Context->preference('template') . '/itemtypeimg';
 494         }
 495 }
 496
 497 =head3 _getImagesFromDirectory
 498
 499   Find all of the image files in a directory in the filesystem
 500
 501   parameters:
 502     a directory name
 503
 504   returns: a list of images in that directory.
 505
 506   Notes: this does not traverse into subdirectories. See
 507       _getSubdirectoryNames for help with that.
 508     Images are assumed to be files with .gif or .png file extensions.
 509     The image names returned do not have the directory name on them.
 510
 511 =cut
 512
 513 sub _getImagesFromDirectory {
 514     my $directoryname = shift;
 515     return unless defined $directoryname;
 516     return unless -d $directoryname;
 517
 518     if ( opendir ( my $dh, $directoryname ) ) {
 519         my @images = grep { /\.(gif|png)$/i } readdir( $dh );
 520         closedir $dh;
 521         return @images;
 522     } else {
 523         warn "unable to opendir $directoryname: $!";
 524         return;
 525     }
 526 }
 527
 528 =head3 _getSubdirectoryNames
 529
 530   Find all of the directories in a directory in the filesystem
 531
 532   parameters:
 533     a directory name
 534
 535   returns: a list of subdirectories in that directory.
 536
 537   Notes: this does not traverse into subdirectories. Only the first
 538       level of subdirectories are returned.
 539     The directory names returned don't have the parent directory name
 540       on them.
 541
 542 =cut
 543
 544 sub _getSubdirectoryNames {
 545     my $directoryname = shift;
 546     return unless defined $directoryname;
 547     return unless -d $directoryname;
 548
 549     if ( opendir ( my $dh, $directoryname ) ) {
 550         my @directories = grep { -d File::Spec->catfile( $directoryname, $_ ) && ! ( /^\./ ) } readdir( $dh );
 551         closedir $dh;
 552         return @directories;
 553     } else {
 554         warn "unable to opendir $directoryname: $!";
 555         return;
 556     }
 557 }
 558
 559 =head3 getImageSets
 560
 561   returns: a listref of hashrefs. Each hash represents another collection of images.
 562            { imagesetname => 'npl', # the name of the image set (npl is the original one)
 563              images => listref of image hashrefs
 564            }
 565
 566     each image is represented by a hashref like this:
 567       { KohaImage     => 'npl/image.gif',
 568         StaffImageUrl => '/intranet-tmpl/prog/img/itemtypeimg/npl/image.gif',
 569         OpacImageURL  => '/opac-tmpl/prog/itemtypeimg/npl/image.gif'
 570         checked       => 0 or 1: was this the image passed to this method?
 571                          Note: I'd like to remove this somehow.
 572       }
 573
 574 =cut
 575
 576 sub getImageSets {
 577     my %params = @_;
 578     my $checked = $params{'checked'} || '';
 579
 580     my $paths = { staff => { filesystem => getitemtypeimagedir('intranet'),
 581                              url        => getitemtypeimagesrc('intranet'),
 582                         },
 583                   opac => { filesystem => getitemtypeimagedir('opac'),
 584                              url       => getitemtypeimagesrc('opac'),
 585                         }
 586                   };
 587
 588     my @imagesets = (); # list of hasrefs of image set data to pass to template
 589     my @subdirectories = _getSubdirectoryNames( $paths->{'staff'}{'filesystem'} );
 590
 591     foreach my $imagesubdir ( @subdirectories ) {
 592         my @imagelist     = (); # hashrefs of image info
 593         my @imagenames = _getImagesFromDirectory( File::Spec->catfile( $paths->{'staff'}{'filesystem'}, $imagesubdir ) );
 594         foreach my $thisimage ( @imagenames ) {
 595             push( @imagelist,
 596                   { KohaImage     => "$imagesubdir/$thisimage",
 597                     StaffImageUrl => join( '/', $paths->{'staff'}{'url'}, $imagesubdir, $thisimage ),
 598                     OpacImageUrl  => join( '/', $paths->{'opac'}{'url'}, $imagesubdir, $thisimage ),
 599                     checked       => "$imagesubdir/$thisimage" eq $checked ? 1 : 0,
 600                }
 601              );
 602         }
 603         push @imagesets, { imagesetname => $imagesubdir,
 604                            images       => \@imagelist };
 605
 606     }
 607     return \@imagesets;
 608 }
 609
 610 =head2 GetPrinters
 611
 612   $printers = &GetPrinters();
 613   @queues = keys %$printers;
 614
 615 Returns information about existing printer queues.
 616
 617 C<$printers> is a reference-to-hash whose keys are the print queues
 618 defined in the printers table of the Koha database. The values are
 619 references-to-hash, whose keys are the fields in the printers table.
 620
 621 =cut
 622
 623 sub GetPrinters {
 624     my %printers;
 625     my $dbh = C4::Context->dbh;
 626     my $sth = $dbh->prepare("select * from printers");
 627     $sth->execute;
 628     while ( my $printer = $sth->fetchrow_hashref ) {
 629         $printers{ $printer->{'printqueue'} } = $printer;
 630     }
 631     return ( \%printers );
 632 }
 633
 634 =head2 GetPrinter
 635
 636 $printer = GetPrinter( $query, $printers );
 637
 638 =cut
 639
 640 sub GetPrinter ($$) {
 641     my ( $query, $printers ) = @_;    # get printer for this query from printers
 642     my $printer = $query->param('printer');
 643     my %cookie = $query->cookie('userenv');
 644     ($printer) || ( $printer = $cookie{'printer'} ) || ( $printer = '' );
 645     ( $printers->{$printer} ) || ( $printer = ( keys %$printers )[0] );
 646     return $printer;
 647 }
 648
 649 =item getnbpages
 650
 651 Returns the number of pages to display in a pagination bar, given the number
 652 of items and the number of items per page.
 653
 654 =cut
 655
 656 sub getnbpages {
 657     my ( $nb_items, $nb_items_per_page ) = @_;
 658
 659     return int( ( $nb_items - 1 ) / $nb_items_per_page ) + 1;
 660 }
 661
 662 =item getallthemes
 663
 664   (@themes) = &getallthemes('opac');
 665   (@themes) = &getallthemes('intranet');
 666
 667 Returns an array of all available themes.
 668
 669 =cut
 670
 671 sub getallthemes {
 672     my $type = shift;
 673     my $htdocs;
 674     my @themes;
 675     if ( $type eq 'intranet' ) {
 676         $htdocs = C4::Context->config('intrahtdocs');
 677     }
 678     else {
 679         $htdocs = C4::Context->config('opachtdocs');
 680     }
 681     opendir D, "$htdocs";
 682     my @dirlist = readdir D;
 683     foreach my $directory (@dirlist) {
 684         -d "$htdocs/$directory/en" and push @themes, $directory;
 685     }
 686     return @themes;
 687 }
 688
 689 sub getFacets {
 690     my $facets;
 691     if ( C4::Context->preference("marcflavour") eq "UNIMARC" ) {
 692         $facets = [
 693             {
 694                 link_value  => 'su-to',
 695                 label_value => 'Topics',
 696                 tags        =>
 697                   [ '600', '601', '602', '603', '604', '605', '606', '610' ],
 698                 subfield => 'a',
 699             },
 700             {
 701                 link_value  => 'su-geo',
 702                 label_value => 'Places',
 703                 tags        => ['651'],
 704                 subfield    => 'a',
 705             },
 706             {
 707                 link_value  => 'su-ut',
 708                 label_value => 'Titles',
 709                 tags        => [ '500', '501', '502', '503', '504', ],
 710                 subfield    => 'a',
 711             },
 712             {
 713                 link_value  => 'au',
 714                 label_value => 'Authors',
 715                 tags        => [ '700', '701', '702', ],
 716                 subfield    => 'a',
 717             },
 718             {
 719                 link_value  => 'se',
 720                 label_value => 'Series',
 721                 tags        => ['225'],
 722                 subfield    => 'a',
 723             },
 724             ];
 725
 726             my $library_facet;
 727
 728             $library_facet = {
 729                 link_value  => 'branch',
 730                 label_value => 'Libraries',
 731                 tags        => [ '995', ],
 732                 subfield    => 'b',
 733                 expanded    => '1',
 734             };
 735             push @$facets, $library_facet unless C4::Context->preference("singleBranchMode");
 736     }
 737     else {
 738         $facets = [
 739             {
 740                 link_value  => 'su-to',
 741                 label_value => 'Topics',
 742                 tags        => ['650'],
 743                 subfield    => 'a',
 744             },
 745
 746             #        {
 747             #        link_value => 'su-na',
 748             #        label_value => 'People and Organizations',
 749             #        tags => ['600', '610', '611'],
 750             #        subfield => 'a',
 751             #        },
 752             {
 753                 link_value  => 'su-geo',
 754                 label_value => 'Places',
 755                 tags        => ['651'],
 756                 subfield    => 'a',
 757             },
 758             {
 759                 link_value  => 'su-ut',
 760                 label_value => 'Titles',
 761                 tags        => ['630'],
 762                 subfield    => 'a',
 763             },
 764             {
 765                 link_value  => 'au',
 766                 label_value => 'Authors',
 767                 tags        => [ '100', '110', '700', ],
 768                 subfield    => 'a',
 769             },
 770             {
 771                 link_value  => 'se',
 772                 label_value => 'Series',
 773                 tags        => [ '440', '490', ],
 774                 subfield    => 'a',
 775             },
 776             ];
 777             my $library_facet;
 778             $library_facet = {
 779                 link_value  => 'branch',
 780                 label_value => 'Libraries',
 781                 tags        => [ '952', ],
 782                 subfield    => 'b',
 783                 expanded    => '1',
 784             };
 785             push @$facets, $library_facet unless C4::Context->preference("singleBranchMode");
 786     }
 787     return $facets;
 788 }
 789
 790 =head2 get_infos_of
 791
 792 Return a href where a key is associated to a href. You give a query,
 793 the name of the key among the fields returned by the query. If you
 794 also give as third argument the name of the value, the function
 795 returns a href of scalar. The optional 4th argument is an arrayref of
 796 items passed to the C<execute()> call. It is designed to bind
 797 parameters to any placeholders in your SQL.
 798
 799   my $query = '
 800 SELECT itemnumber,
 801        notforloan,
 802        barcode
 803   FROM items
 804 ';
 805
 806   # generic href of any information on the item, href of href.
 807   my $iteminfos_of = get_infos_of($query, 'itemnumber');
 808   print $iteminfos_of->{$itemnumber}{barcode};
 809
 810   # specific information, href of scalar
 811   my $barcode_of_item = get_infos_of($query, 'itemnumber', 'barcode');
 812   print $barcode_of_item->{$itemnumber};
 813
 814 =cut
 815
 816 sub get_infos_of {
 817     my ( $query, $key_name, $value_name, $bind_params ) = @_;
 818
 819     my $dbh = C4::Context->dbh;
 820
 821     my $sth = $dbh->prepare($query);
 822     $sth->execute( @$bind_params );
 823
 824     my %infos_of;
 825     while ( my $row = $sth->fetchrow_hashref ) {
 826         if ( defined $value_name ) {
 827             $infos_of{ $row->{$key_name} } = $row->{$value_name};
 828         }
 829         else {
 830             $infos_of{ $row->{$key_name} } = $row;
 831         }
 832     }
 833     $sth->finish;
 834
 835     return \%infos_of;
 836 }
 837
 838 =head2 get_notforloan_label_of
 839
 840   my $notforloan_label_of = get_notforloan_label_of();
 841
 842 Each authorised value of notforloan (information available in items and
 843 itemtypes) is link to a single label.
 844
 845 Returns a href where keys are authorised values and values are corresponding
 846 labels.
 847
 848   foreach my $authorised_value (keys %{$notforloan_label_of}) {
 849     printf(
 850         "authorised_value: %s => %s\n",
 851         $authorised_value,
 852         $notforloan_label_of->{$authorised_value}
 853     );
 854   }
 855
 856 =cut
 857
 858 # FIXME - why not use GetAuthorisedValues ??
 859 #
 860 sub get_notforloan_label_of {
 861     my $dbh = C4::Context->dbh;
 862
 863     my $query = '
 864 SELECT authorised_value
 865   FROM marc_subfield_structure
 866   WHERE kohafield = \'items.notforloan\'
 867   LIMIT 0, 1
 868 ';
 869     my $sth = $dbh->prepare($query);
 870     $sth->execute();
 871     my ($statuscode) = $sth->fetchrow_array();
 872
 873     $query = '
 874 SELECT lib,
 875        authorised_value
 876   FROM authorised_values
 877   WHERE category = ?
 878 ';
 879     $sth = $dbh->prepare($query);
 880     $sth->execute($statuscode);
 881     my %notforloan_label_of;
 882     while ( my $row = $sth->fetchrow_hashref ) {
 883         $notforloan_label_of{ $row->{authorised_value} } = $row->{lib};
 884     }
 885     $sth->finish;
 886
 887     return \%notforloan_label_of;
 888 }
 889
 890 =head2 displayServers
 891
 892 =over 4
 893
 894 my $servers = displayServers();
 895
 896 my $servers = displayServers( $position );
 897
 898 my $servers = displayServers( $position, $type );
 899
 900 =back
 901
 902 displayServers returns a listref of hashrefs, each containing
 903 information about available z3950 servers. Each hashref has a format
 904 like:
 905
 906     {
 907       'checked'    => 'checked',
 908       'encoding'   => 'MARC-8'
 909       'icon'       => undef,
 910       'id'         => 'LIBRARY OF CONGRESS',
 911       'label'      => '',
 912       'name'       => 'server',
 913       'opensearch' => '',
 914       'value'      => 'z3950.loc.gov:7090/',
 915       'zed'        => 1,
 916     },
 917
 918
 919 =cut
 920
 921 sub displayServers {
 922     my ( $position, $type ) = @_;
 923     my $dbh = C4::Context->dbh;
 924
 925     my $strsth = 'SELECT * FROM z3950servers';
 926     my @where_clauses;
 927     my @bind_params;
 928
 929     if ($position) {
 930         push @bind_params,   $position;
 931         push @where_clauses, ' position = ? ';
 932     }
 933
 934     if ($type) {
 935         push @bind_params,   $type;
 936         push @where_clauses, ' type = ? ';
 937     }
 938
 939     # reassemble where clause from where clause pieces
 940     if (@where_clauses) {
 941         $strsth .= ' WHERE ' . join( ' AND ', @where_clauses );
 942     }
 943
 944     my $rq = $dbh->prepare($strsth);
 945     $rq->execute(@bind_params);
 946     my @primaryserverloop;
 947
 948     while ( my $data = $rq->fetchrow_hashref ) {
 949         push @primaryserverloop,
 950           { label    => $data->{description},
 951             id       => $data->{name},
 952             name     => "server",
 953             value    => $data->{host} . ":" . $data->{port} . "/" . $data->{database},
 954             encoding => ( $data->{encoding} ? $data->{encoding} : "iso-5426" ),
 955             checked  => "checked",
 956             icon     => $data->{icon},
 957             zed        => $data->{type} eq 'zed',
 958             opensearch => $data->{type} eq 'opensearch'
 959           };
 960     }
 961     return \@primaryserverloop;
 962 }
 963
 964 sub displaySecondaryServers {
 965
 966 #       my $secondary_servers_loop = [
 967 #               { inner_sup_servers_loop => [
 968 #               {label => "Google", id=>"GOOG", value=>"google",icon => "google.ico",opensearch => "1"},
 969 #               {label => "Yahoo", id=>"YAH", value=>"yahoo", icon =>"yahoo.ico", zed => "1"},
 970 #               {label => "Worldcat", id=>"WCT", value=>"worldcat", icon => "worldcat.gif", zed => "1"},
 971 #               {label => "Library of Congress", id=>"LOC", name=> "server", value=>"z3950.loc.gov:7090/Voyager", icon =>"loc.ico", zed => "1"},
 972 #       ],
 973 #       },
 974 #       ];
 975     return;    #$secondary_servers_loop;
 976 }
 977
 978 =head2 GetAuthValCode
 979
 980 $authvalcode = GetAuthValCode($kohafield,$frameworkcode);
 981
 982 =cut
 983
 984 sub GetAuthValCode {
 985         my ($kohafield,$fwcode) = @_;
 986         my $dbh = C4::Context->dbh;
 987         $fwcode='' unless $fwcode;
 988         my $sth = $dbh->prepare('select authorised_value from marc_subfield_structure where kohafield=? and frameworkcode=?');
 989         $sth->execute($kohafield,$fwcode);
 990         my ($authvalcode) = $sth->fetchrow_array;
 991         return $authvalcode;
 992 }
 993
 994 =head2 GetAuthorisedValues
 995
 996 $authvalues = GetAuthorisedValues($category);
 997
 998 this function get all authorised values from 'authosied_value' table into a reference to array which
 999 each value containt an hashref.
1000
1001 Set C<$category> on input args if you want to limits your query to this one. This params is not mandatory.
1002
1003 =cut
1004
1005 sub GetAuthorisedValues {
1006     my ($category,$selected) = @_;
1007         my $count = 0;
1008         my @results;
1009     my $dbh      = C4::Context->dbh;
1010     my $query    = "SELECT * FROM authorised_values";
1011     $query .= " WHERE category = '" . $category . "'" if $category;
1012
1013     my $sth = $dbh->prepare($query);
1014     $sth->execute;
1015         while (my $data=$sth->fetchrow_hashref) {
1016                 if ($selected eq $data->{'authorised_value'} ) {
1017                         $data->{'selected'} = 1;
1018                 }
1019                 $results[$count] = $data;
1020                 $count++;
1021         }
1022     #my $data = $sth->fetchall_arrayref({});
1023     return \@results; #$data;
1024 }
1025
1026 =head2 GetAuthorisedValueCategories
1027
1028 $auth_categories = GetAuthorisedValueCategories();
1029
1030 Return an arrayref of all of the available authorised
1031 value categories.
1032
1033 =cut
1034
1035 sub GetAuthorisedValueCategories {
1036     my $dbh = C4::Context->dbh;
1037     my $sth = $dbh->prepare("SELECT DISTINCT category FROM authorised_values ORDER BY category");
1038     $sth->execute;
1039     my @results;
1040     while (my $category = $sth->fetchrow_array) {
1041         push @results, $category;
1042     }
1043     return \@results;
1044 }
1045
1046 =head2 GetKohaAuthorisedValues
1047
1048         Takes $kohafield, $fwcode as parameters.
1049         Returns hashref of Code => description
1050         Returns undef
1051           if no authorised value category is defined for the kohafield.
1052
1053 =cut
1054
1055 sub GetKohaAuthorisedValues {
1056   my ($kohafield,$fwcode,$codedvalue) = @_;
1057   $fwcode='' unless $fwcode;
1058   my %values;
1059   my $dbh = C4::Context->dbh;
1060   my $avcode = GetAuthValCode($kohafield,$fwcode);
1061   if ($avcode) {
1062         my $sth = $dbh->prepare("select authorised_value, lib from authorised_values where category=? ");
1063         $sth->execute($avcode);
1064         while ( my ($val, $lib) = $sth->fetchrow_array ) {
1065                 $values{$val}= $lib;
1066         }
1067         return \%values;
1068   } else {
1069         return undef;
1070   }
1071 }
1072
1073 =head2 GetManagedTagSubfields
1074
1075 =over 4
1076
1077 $res = GetManagedTagSubfields();
1078
1079 =back
1080
1081 Returns a reference to a big hash of hash, with the Marc structure fro the given frameworkcode
1082
1083 NOTE: This function is used only by the (incomplete) bulk editing feature.  Since
1084 that feature currently does not deal with items and biblioitems changes
1085 correctly, those tags are specifically excluded from the list prepared
1086 by this function.
1087
1088 For future reference, if a bulk item editing feature is implemented at some point, it
1089 needs some design thought -- for example, circulation status fields should not
1090 be changed willy-nilly.
1091
1092 =cut
1093
1094 sub GetManagedTagSubfields{
1095   my $dbh=C4::Context->dbh;
1096   my $rq=$dbh->prepare(qq|
1097 SELECT
1098   DISTINCT CONCAT( marc_subfield_structure.tagfield, tagsubfield ) AS tagsubfield,
1099   marc_subfield_structure.liblibrarian as subfielddesc,
1100   marc_tag_structure.liblibrarian as tagdesc
1101 FROM marc_subfield_structure
1102   LEFT JOIN marc_tag_structure
1103     ON marc_tag_structure.tagfield = marc_subfield_structure.tagfield
1104     AND marc_tag_structure.frameworkcode = marc_subfield_structure.frameworkcode
1105 WHERE marc_subfield_structure.tab>=0
1106 AND marc_tag_structure.tagfield NOT IN (SELECT tagfield FROM marc_subfield_structure WHERE kohafield like 'items.%')
1107 AND marc_tag_structure.tagfield NOT IN (SELECT tagfield FROM marc_subfield_structure WHERE kohafield = 'biblioitems.itemtype')
1108 AND marc_subfield_structure.kohafield <> 'biblio.biblionumber'
1109 AND marc_subfield_structure.kohafield <>  'biblioitems.biblioitemnumber'
1110 ORDER BY marc_subfield_structure.tagfield, tagsubfield|);
1111   $rq->execute;
1112   my $data=$rq->fetchall_arrayref({});
1113   return $data;
1114 }
1115
1116 =head2 display_marc_indicators
1117
1118 =over 4
1119
1120 # field is a MARC::Field object
1121 my $display_form = C4::Koha::display_marc_indicators($field);
1122
1123 =back
1124
1125 Generate a display form of the indicators of a variable
1126 MARC field, replacing any blanks with '#'.
1127
1128 =cut
1129
1130 sub display_marc_indicators {
1131     my $field = shift;
1132     my $indicators = '';
1133     if ($field->tag() >= 10) {
1134         $indicators = $field->indicator(1) . $field->indicator(2);
1135         $indicators =~ s/ /#/g;
1136     }
1137     return $indicators;
1138 }
1139
1140 1;
1141
1142 __END__
1143
1144 =head1 AUTHOR
1145
1146 Koha Team
1147
1148 =cut