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