koha-dev.rot13.org Git - koha_gimpoz/blob - C4/Koha.pm

   1 package C4::Koha;
   2
   3 # Copyright 2000-2002 Katipo Communications
   4 #
   5 # This file is part of Koha.
   6 #
   7 # Koha is free software; you can redistribute it and/or modify it under the
   8 # terms of the GNU General Public License as published by the Free Software
   9 # Foundation; either version 2 of the License, or (at your option) any later
  10 # version.
  11 #
  12 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
  13 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
  14 # A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
  15 #
  16 # You should have received a copy of the GNU General Public License along with
  17 # Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
  18 # Suite 330, Boston, MA  02111-1307 USA
  19
  20
  21 use strict;
  22 use C4::Context;
  23 use C4::Output;
  24
  25 use vars qw($VERSION @ISA @EXPORT $DEBUG);
  26
  27 BEGIN {
  28         $VERSION = 3.01;
  29         require Exporter;
  30         @ISA    = qw(Exporter);
  31         @EXPORT = qw(
  32                 &slashifyDate
  33                 &DisplayISBN
  34                 &subfield_is_koha_internal_p
  35                 &GetPrinters &GetPrinter
  36                 &GetItemTypes &getitemtypeinfo
  37                 &GetCcodes
  38                 &get_itemtypeinfos_of
  39                 &getframeworks &getframeworkinfo
  40                 &getauthtypes &getauthtype
  41                 &getallthemes
  42                 &getFacets
  43                 &displayServers
  44                 &getnbpages
  45                 &getitemtypeimagesrcfromurl
  46                 &get_infos_of
  47                 &get_notforloan_label_of
  48                 &getitemtypeimagedir
  49                 &getitemtypeimagesrc
  50                 &GetAuthorisedValues
  51                 &GetAuthorisedValueCategories
  52                 &GetKohaAuthorisedValues
  53                 &GetAuthValCode
  54                 &GetManagedTagSubfields
  55
  56                 $DEBUG
  57         );
  58         $DEBUG = 0;
  59 }
  60
  61 =head1 NAME
  62
  63     C4::Koha - Perl Module containing convenience functions for Koha scripts
  64
  65 =head1 SYNOPSIS
  66
  67   use C4::Koha;
  68
  69
  70 =head1 DESCRIPTION
  71
  72     Koha.pm provides many functions for Koha scripts.
  73
  74 =head1 FUNCTIONS
  75
  76 =over 2
  77
  78 =cut
  79 =head2 slashifyDate
  80
  81   $slash_date = &slashifyDate($dash_date);
  82
  83     Takes a string of the form "DD-MM-YYYY" (or anything separated by
  84     dashes), converts it to the form "YYYY/MM/DD", and returns the result.
  85
  86 =cut
  87
  88 sub slashifyDate {
  89
  90     # accepts a date of the form xx-xx-xx[xx] and returns it in the
  91     # form xx/xx/xx[xx]
  92     my @dateOut = split( '-', shift );
  93     return ("$dateOut[2]/$dateOut[1]/$dateOut[0]");
  94 }
  95
  96
  97 =head2 DisplayISBN
  98
  99     my $string = DisplayISBN( $isbn );
 100
 101 =cut
 102
 103 sub DisplayISBN {
 104     my ($isbn) = @_;
 105     if (length ($isbn)<13){
 106     my $seg1;
 107     if ( substr( $isbn, 0, 1 ) <= 7 ) {
 108         $seg1 = substr( $isbn, 0, 1 );
 109     }
 110     elsif ( substr( $isbn, 0, 2 ) <= 94 ) {
 111         $seg1 = substr( $isbn, 0, 2 );
 112     }
 113     elsif ( substr( $isbn, 0, 3 ) <= 995 ) {
 114         $seg1 = substr( $isbn, 0, 3 );
 115     }
 116     elsif ( substr( $isbn, 0, 4 ) <= 9989 ) {
 117         $seg1 = substr( $isbn, 0, 4 );
 118     }
 119     else {
 120         $seg1 = substr( $isbn, 0, 5 );
 121     }
 122     my $x = substr( $isbn, length($seg1) );
 123     my $seg2;
 124     if ( substr( $x, 0, 2 ) <= 19 ) {
 125
 126         # if(sTmp2 < 10) sTmp2 = "0" sTmp2;
 127         $seg2 = substr( $x, 0, 2 );
 128     }
 129     elsif ( substr( $x, 0, 3 ) <= 699 ) {
 130         $seg2 = substr( $x, 0, 3 );
 131     }
 132     elsif ( substr( $x, 0, 4 ) <= 8399 ) {
 133         $seg2 = substr( $x, 0, 4 );
 134     }
 135     elsif ( substr( $x, 0, 5 ) <= 89999 ) {
 136         $seg2 = substr( $x, 0, 5 );
 137     }
 138     elsif ( substr( $x, 0, 6 ) <= 9499999 ) {
 139         $seg2 = substr( $x, 0, 6 );
 140     }
 141     else {
 142         $seg2 = substr( $x, 0, 7 );
 143     }
 144     my $seg3 = substr( $x, length($seg2) );
 145     $seg3 = substr( $seg3, 0, length($seg3) - 1 );
 146     my $seg4 = substr( $x, -1, 1 );
 147     return "$seg1-$seg2-$seg3-$seg4";
 148     } else {
 149       my $seg1;
 150       $seg1 = substr( $isbn, 0, 3 );
 151       my $seg2;
 152       if ( substr( $isbn, 3, 1 ) <= 7 ) {
 153           $seg2 = substr( $isbn, 3, 1 );
 154       }
 155       elsif ( substr( $isbn, 3, 2 ) <= 94 ) {
 156           $seg2 = substr( $isbn, 3, 2 );
 157       }
 158       elsif ( substr( $isbn, 3, 3 ) <= 995 ) {
 159           $seg2 = substr( $isbn, 3, 3 );
 160       }
 161       elsif ( substr( $isbn, 3, 4 ) <= 9989 ) {
 162           $seg2 = substr( $isbn, 3, 4 );
 163       }
 164       else {
 165           $seg2 = substr( $isbn, 3, 5 );
 166       }
 167       my $x = substr( $isbn, length($seg2) +3);
 168       my $seg3;
 169       if ( substr( $x, 0, 2 ) <= 19 ) {
 170
 171           # if(sTmp2 < 10) sTmp2 = "0" sTmp2;
 172           $seg3 = substr( $x, 0, 2 );
 173       }
 174       elsif ( substr( $x, 0, 3 ) <= 699 ) {
 175           $seg3 = substr( $x, 0, 3 );
 176       }
 177       elsif ( substr( $x, 0, 4 ) <= 8399 ) {
 178           $seg3 = substr( $x, 0, 4 );
 179       }
 180       elsif ( substr( $x, 0, 5 ) <= 89999 ) {
 181           $seg3 = substr( $x, 0, 5 );
 182       }
 183       elsif ( substr( $x, 0, 6 ) <= 9499999 ) {
 184           $seg3 = substr( $x, 0, 6 );
 185       }
 186       else {
 187           $seg3 = substr( $x, 0, 7 );
 188       }
 189       my $seg4 = substr( $x, length($seg3) );
 190       $seg4 = substr( $seg4, 0, length($seg4) - 1 );
 191       my $seg5 = substr( $x, -1, 1 );
 192       return "$seg1-$seg2-$seg3-$seg4-$seg5";
 193     }
 194 }
 195
 196 # FIXME.. this should be moved to a MARC-specific module
 197 sub subfield_is_koha_internal_p ($) {
 198     my ($subfield) = @_;
 199
 200     # We could match on 'lib' and 'tab' (and 'mandatory', & more to come!)
 201     # But real MARC subfields are always single-character
 202     # so it really is safer just to check the length
 203
 204     return length $subfield != 1;
 205 }
 206
 207 =head2 GetItemTypes
 208
 209   $itemtypes = &GetItemTypes();
 210
 211 Returns information about existing itemtypes.
 212
 213 build a HTML select with the following code :
 214
 215 =head3 in PERL SCRIPT
 216
 217     my $itemtypes = GetItemTypes;
 218     my @itemtypesloop;
 219     foreach my $thisitemtype (sort keys %$itemtypes) {
 220         my $selected = 1 if $thisitemtype eq $itemtype;
 221         my %row =(value => $thisitemtype,
 222                     selected => $selected,
 223                     description => $itemtypes->{$thisitemtype}->{'description'},
 224                 );
 225         push @itemtypesloop, \%row;
 226     }
 227     $template->param(itemtypeloop => \@itemtypesloop);
 228
 229 =head3 in TEMPLATE
 230
 231     <form action='<!-- TMPL_VAR name="script_name" -->' method=post>
 232         <select name="itemtype">
 233             <option value="">Default</option>
 234         <!-- TMPL_LOOP name="itemtypeloop" -->
 235             <option value="<!-- TMPL_VAR name="value" -->" <!-- TMPL_IF name="selected" -->selected<!-- /TMPL_IF -->><!-- TMPL_VAR name="description" --></option>
 236         <!-- /TMPL_LOOP -->
 237         </select>
 238         <input type=text name=searchfield value="<!-- TMPL_VAR name="searchfield" -->">
 239         <input type="submit" value="OK" class="button">
 240     </form>
 241
 242 =cut
 243
 244 sub GetItemTypes {
 245
 246     # returns a reference to a hash of references to branches...
 247     my %itemtypes;
 248     my $dbh   = C4::Context->dbh;
 249     my $query = qq|
 250         SELECT *
 251         FROM   itemtypes
 252     |;
 253     my $sth = $dbh->prepare($query);
 254     $sth->execute;
 255     while ( my $IT = $sth->fetchrow_hashref ) {
 256         $itemtypes{ $IT->{'itemtype'} } = $IT;
 257     }
 258     return ( \%itemtypes );
 259 }
 260
 261 sub get_itemtypeinfos_of {
 262     my @itemtypes = @_;
 263
 264     my $query = '
 265 SELECT itemtype,
 266        description,
 267        imageurl,
 268        notforloan
 269   FROM itemtypes
 270   WHERE itemtype IN (' . join( ',', map( { "'" . $_ . "'" } @itemtypes ) ) . ')
 271 ';
 272
 273     return get_infos_of( $query, 'itemtype' );
 274 }
 275
 276 # this is temporary until we separate collection codes and item types
 277 sub GetCcodes {
 278     my $count = 0;
 279     my @results;
 280     my $dbh = C4::Context->dbh;
 281     my $sth =
 282       $dbh->prepare(
 283         "SELECT * FROM authorised_values ORDER BY authorised_value");
 284     $sth->execute;
 285     while ( my $data = $sth->fetchrow_hashref ) {
 286         if ( $data->{category} eq "CCODE" ) {
 287             $count++;
 288             $results[$count] = $data;
 289
 290             #warn "data: $data";
 291         }
 292     }
 293     $sth->finish;
 294     return ( $count, @results );
 295 }
 296
 297 =head2 getauthtypes
 298
 299   $authtypes = &getauthtypes();
 300
 301 Returns information about existing authtypes.
 302
 303 build a HTML select with the following code :
 304
 305 =head3 in PERL SCRIPT
 306
 307 my $authtypes = getauthtypes;
 308 my @authtypesloop;
 309 foreach my $thisauthtype (keys %$authtypes) {
 310     my $selected = 1 if $thisauthtype eq $authtype;
 311     my %row =(value => $thisauthtype,
 312                 selected => $selected,
 313                 authtypetext => $authtypes->{$thisauthtype}->{'authtypetext'},
 314             );
 315     push @authtypesloop, \%row;
 316 }
 317 $template->param(itemtypeloop => \@itemtypesloop);
 318
 319 =head3 in TEMPLATE
 320
 321 <form action='<!-- TMPL_VAR name="script_name" -->' method=post>
 322     <select name="authtype">
 323     <!-- TMPL_LOOP name="authtypeloop" -->
 324         <option value="<!-- TMPL_VAR name="value" -->" <!-- TMPL_IF name="selected" -->selected<!-- /TMPL_IF -->><!-- TMPL_VAR name="authtypetext" --></option>
 325     <!-- /TMPL_LOOP -->
 326     </select>
 327     <input type=text name=searchfield value="<!-- TMPL_VAR name="searchfield" -->">
 328     <input type="submit" value="OK" class="button">
 329 </form>
 330
 331
 332 =cut
 333
 334 sub getauthtypes {
 335
 336     # returns a reference to a hash of references to authtypes...
 337     my %authtypes;
 338     my $dbh = C4::Context->dbh;
 339     my $sth = $dbh->prepare("select * from auth_types order by authtypetext");
 340     $sth->execute;
 341     while ( my $IT = $sth->fetchrow_hashref ) {
 342         $authtypes{ $IT->{'authtypecode'} } = $IT;
 343     }
 344     return ( \%authtypes );
 345 }
 346
 347 sub getauthtype {
 348     my ($authtypecode) = @_;
 349
 350     # returns a reference to a hash of references to authtypes...
 351     my %authtypes;
 352     my $dbh = C4::Context->dbh;
 353     my $sth = $dbh->prepare("select * from auth_types where authtypecode=?");
 354     $sth->execute($authtypecode);
 355     my $res = $sth->fetchrow_hashref;
 356     return $res;
 357 }
 358
 359 =head2 getframework
 360
 361   $frameworks = &getframework();
 362
 363 Returns information about existing frameworks
 364
 365 build a HTML select with the following code :
 366
 367 =head3 in PERL SCRIPT
 368
 369 my $frameworks = frameworks();
 370 my @frameworkloop;
 371 foreach my $thisframework (keys %$frameworks) {
 372     my $selected = 1 if $thisframework eq $frameworkcode;
 373     my %row =(value => $thisframework,
 374                 selected => $selected,
 375                 description => $frameworks->{$thisframework}->{'frameworktext'},
 376             );
 377     push @frameworksloop, \%row;
 378 }
 379 $template->param(frameworkloop => \@frameworksloop);
 380
 381 =head3 in TEMPLATE
 382
 383 <form action='<!-- TMPL_VAR name="script_name" -->' method=post>
 384     <select name="frameworkcode">
 385         <option value="">Default</option>
 386     <!-- TMPL_LOOP name="frameworkloop" -->
 387         <option value="<!-- TMPL_VAR name="value" -->" <!-- TMPL_IF name="selected" -->selected<!-- /TMPL_IF -->><!-- TMPL_VAR name="frameworktext" --></option>
 388     <!-- /TMPL_LOOP -->
 389     </select>
 390     <input type=text name=searchfield value="<!-- TMPL_VAR name="searchfield" -->">
 391     <input type="submit" value="OK" class="button">
 392 </form>
 393
 394
 395 =cut
 396
 397 sub getframeworks {
 398
 399     # returns a reference to a hash of references to branches...
 400     my %itemtypes;
 401     my $dbh = C4::Context->dbh;
 402     my $sth = $dbh->prepare("select * from biblio_framework");
 403     $sth->execute;
 404     while ( my $IT = $sth->fetchrow_hashref ) {
 405         $itemtypes{ $IT->{'frameworkcode'} } = $IT;
 406     }
 407     return ( \%itemtypes );
 408 }
 409
 410 =head2 getframeworkinfo
 411
 412   $frameworkinfo = &getframeworkinfo($frameworkcode);
 413
 414 Returns information about an frameworkcode.
 415
 416 =cut
 417
 418 sub getframeworkinfo {
 419     my ($frameworkcode) = @_;
 420     my $dbh             = C4::Context->dbh;
 421     my $sth             =
 422       $dbh->prepare("select * from biblio_framework where frameworkcode=?");
 423     $sth->execute($frameworkcode);
 424     my $res = $sth->fetchrow_hashref;
 425     return $res;
 426 }
 427
 428 =head2 getitemtypeinfo
 429
 430   $itemtype = &getitemtype($itemtype);
 431
 432 Returns information about an itemtype.
 433
 434 =cut
 435
 436 sub getitemtypeinfo {
 437     my ($itemtype) = @_;
 438     my $dbh        = C4::Context->dbh;
 439     my $sth        = $dbh->prepare("select * from itemtypes where itemtype=?");
 440     $sth->execute($itemtype);
 441     my $res = $sth->fetchrow_hashref;
 442
 443     $res->{imageurl} = getitemtypeimagesrcfromurl( $res->{imageurl} );
 444
 445     return $res;
 446 }
 447
 448 sub getitemtypeimagesrcfromurl {
 449     my ($imageurl) = @_;
 450
 451     if ( defined $imageurl and $imageurl !~ m/^http/ ) {
 452         $imageurl = getitemtypeimagesrc() . '/' . $imageurl;
 453     }
 454
 455     return $imageurl;
 456 }
 457
 458 =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 =item 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 =item 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, the
 792 name of the key among the fields returned by the query. If you also give as
 793 third argument the name of the value, the function returns a href of scalar.
 794
 795   my $query = '
 796 SELECT itemnumber,
 797        notforloan,
 798        barcode
 799   FROM items
 800 ';
 801
 802   # generic href of any information on the item, href of href.
 803   my $iteminfos_of = get_infos_of($query, 'itemnumber');
 804   print $iteminfos_of->{$itemnumber}{barcode};
 805
 806   # specific information, href of scalar
 807   my $barcode_of_item = get_infos_of($query, 'itemnumber', 'barcode');
 808   print $barcode_of_item->{$itemnumber};
 809
 810 =cut
 811
 812 sub get_infos_of {
 813     my ( $query, $key_name, $value_name ) = @_;
 814
 815     my $dbh = C4::Context->dbh;
 816
 817     my $sth = $dbh->prepare($query);
 818     $sth->execute();
 819
 820     my %infos_of;
 821     while ( my $row = $sth->fetchrow_hashref ) {
 822         if ( defined $value_name ) {
 823             $infos_of{ $row->{$key_name} } = $row->{$value_name};
 824         }
 825         else {
 826             $infos_of{ $row->{$key_name} } = $row;
 827         }
 828     }
 829     $sth->finish;
 830
 831     return \%infos_of;
 832 }
 833
 834 =head2 get_notforloan_label_of
 835
 836   my $notforloan_label_of = get_notforloan_label_of();
 837
 838 Each authorised value of notforloan (information available in items and
 839 itemtypes) is link to a single label.
 840
 841 Returns a href where keys are authorised values and values are corresponding
 842 labels.
 843
 844   foreach my $authorised_value (keys %{$notforloan_label_of}) {
 845     printf(
 846         "authorised_value: %s => %s\n",
 847         $authorised_value,
 848         $notforloan_label_of->{$authorised_value}
 849     );
 850   }
 851
 852 =cut
 853
 854 # FIXME - why not use GetAuthorisedValues ??
 855 #
 856 sub get_notforloan_label_of {
 857     my $dbh = C4::Context->dbh;
 858
 859     my $query = '
 860 SELECT authorised_value
 861   FROM marc_subfield_structure
 862   WHERE kohafield = \'items.notforloan\'
 863   LIMIT 0, 1
 864 ';
 865     my $sth = $dbh->prepare($query);
 866     $sth->execute();
 867     my ($statuscode) = $sth->fetchrow_array();
 868
 869     $query = '
 870 SELECT lib,
 871        authorised_value
 872   FROM authorised_values
 873   WHERE category = ?
 874 ';
 875     $sth = $dbh->prepare($query);
 876     $sth->execute($statuscode);
 877     my %notforloan_label_of;
 878     while ( my $row = $sth->fetchrow_hashref ) {
 879         $notforloan_label_of{ $row->{authorised_value} } = $row->{lib};
 880     }
 881     $sth->finish;
 882
 883     return \%notforloan_label_of;
 884 }
 885
 886 sub displayServers {
 887     my ( $position, $type ) = @_;
 888     my $dbh    = C4::Context->dbh;
 889     my $strsth = "SELECT * FROM z3950servers where 1";
 890     $strsth .= " AND position=\"$position\"" if ($position);
 891     $strsth .= " AND type=\"$type\""         if ($type);
 892     my $rq = $dbh->prepare($strsth);
 893     $rq->execute;
 894     my @primaryserverloop;
 895
 896     while ( my $data = $rq->fetchrow_hashref ) {
 897         my %cell;
 898         $cell{label} = $data->{'description'};
 899         $cell{id}    = $data->{'name'};
 900         $cell{value} =
 901             $data->{host}
 902           . ( $data->{port} ? ":" . $data->{port} : "" ) . "/"
 903           . $data->{database}
 904           if ( $data->{host} );
 905         $cell{checked} = $data->{checked};
 906         push @primaryserverloop,
 907           {
 908             label => $data->{description},
 909             id    => $data->{name},
 910             name  => "server",
 911             value => $data->{host} . ":"
 912               . $data->{port} . "/"
 913               . $data->{database},
 914             encoding   => ($data->{encoding}?$data->{encoding}:"iso-5426"),
 915             checked    => "checked",
 916             icon       => $data->{icon},
 917             zed        => $data->{type} eq 'zed',
 918             opensearch => $data->{type} eq 'opensearch'
 919           };
 920     }
 921     return \@primaryserverloop;
 922 }
 923
 924 sub displaySecondaryServers {
 925
 926 #       my $secondary_servers_loop = [
 927 #               { inner_sup_servers_loop => [
 928 #               {label => "Google", id=>"GOOG", value=>"google",icon => "google.ico",opensearch => "1"},
 929 #               {label => "Yahoo", id=>"YAH", value=>"yahoo", icon =>"yahoo.ico", zed => "1"},
 930 #               {label => "Worldcat", id=>"WCT", value=>"worldcat", icon => "worldcat.gif", zed => "1"},
 931 #               {label => "Library of Congress", id=>"LOC", name=> "server", value=>"z3950.loc.gov:7090/Voyager", icon =>"loc.ico", zed => "1"},
 932 #       ],
 933 #       },
 934 #       ];
 935     return;    #$secondary_servers_loop;
 936 }
 937
 938 =head2 GetAuthValCode
 939
 940 $authvalcode = GetAuthValCode($kohafield,$frameworkcode);
 941
 942 =cut
 943
 944 sub GetAuthValCode {
 945         my ($kohafield,$fwcode) = @_;
 946         my $dbh = C4::Context->dbh;
 947         $fwcode='' unless $fwcode;
 948         my $sth = $dbh->prepare('select authorised_value from marc_subfield_structure where kohafield=? and frameworkcode=?');
 949         $sth->execute($kohafield,$fwcode);
 950         my ($authvalcode) = $sth->fetchrow_array;
 951         return $authvalcode;
 952 }
 953
 954 =head2 GetAuthorisedValues
 955
 956 $authvalues = GetAuthorisedValues($category);
 957
 958 this function get all authorised values from 'authosied_value' table into a reference to array which
 959 each value containt an hashref.
 960
 961 Set C<$category> on input args if you want to limits your query to this one. This params is not mandatory.
 962
 963 =cut
 964
 965 sub GetAuthorisedValues {
 966     my ($category,$selected) = @_;
 967         my $count = 0;
 968         my @results;
 969     my $dbh      = C4::Context->dbh;
 970     my $query    = "SELECT * FROM authorised_values";
 971     $query .= " WHERE category = '" . $category . "'" if $category;
 972
 973     my $sth = $dbh->prepare($query);
 974     $sth->execute;
 975         while (my $data=$sth->fetchrow_hashref) {
 976                 if ($selected eq $data->{'authorised_value'} ) {
 977                         $data->{'selected'} = 1;
 978                 }
 979                 $results[$count] = $data;
 980                 $count++;
 981         }
 982     #my $data = $sth->fetchall_arrayref({});
 983     return \@results; #$data;
 984 }
 985
 986 =head2 GetAuthorisedValueCategories
 987
 988 $auth_categories = GetAuthorisedValueCategories();
 989
 990 Return an arrayref of all of the available authorised
 991 value categories.
 992
 993 =cut
 994
 995 sub GetAuthorisedValueCategories {
 996     my $dbh = C4::Context->dbh;
 997     my $sth = $dbh->prepare("SELECT DISTINCT category FROM authorised_values ORDER BY category");
 998     $sth->execute;
 999     my @results;
1000     while (my $category = $sth->fetchrow_array) {
1001         push @results, $category;
1002     }
1003     return \@results;
1004 }
1005
1006 =head2 GetKohaAuthorisedValues
1007
1008         Takes $kohafield, $fwcode as parameters.
1009         Returns hashref of Code => description
1010         Returns undef
1011           if no authorised value category is defined for the kohafield.
1012
1013 =cut
1014
1015 sub GetKohaAuthorisedValues {
1016   my ($kohafield,$fwcode,$codedvalue) = @_;
1017   $fwcode='' unless $fwcode;
1018   my %values;
1019   my $dbh = C4::Context->dbh;
1020   my $avcode = GetAuthValCode($kohafield,$fwcode);
1021   if ($avcode) {
1022         my $sth = $dbh->prepare("select authorised_value, lib from authorised_values where category=? ");
1023         $sth->execute($avcode);
1024         while ( my ($val, $lib) = $sth->fetchrow_array ) {
1025                 $values{$val}= $lib;
1026         }
1027         return \%values;
1028   } else {
1029         return undef;
1030   }
1031 }
1032
1033 =head2 GetManagedTagSubfields
1034
1035 =over 4
1036
1037 $res = GetManagedTagSubfields();
1038
1039 =back
1040
1041 Returns a reference to a big hash of hash, with the Marc structure fro the given frameworkcode
1042
1043 NOTE: This function is used only by the (incomplete) bulk editing feature.  Since
1044 that feature currently does not deal with items and biblioitems changes
1045 correctly, those tags are specifically excluded from the list prepared
1046 by this function.
1047
1048 For future reference, if a bulk item editing feature is implemented at some point, it
1049 needs some design thought -- for example, circulation status fields should not
1050 be changed willy-nilly.
1051
1052 =cut
1053
1054 sub GetManagedTagSubfields{
1055   my $dbh=C4::Context->dbh;
1056   my $rq=$dbh->prepare(qq|
1057 SELECT
1058   DISTINCT CONCAT( marc_subfield_structure.tagfield, tagsubfield ) AS tagsubfield,
1059   marc_subfield_structure.liblibrarian as subfielddesc,
1060   marc_tag_structure.liblibrarian as tagdesc
1061 FROM marc_subfield_structure
1062   LEFT JOIN marc_tag_structure
1063     ON marc_tag_structure.tagfield = marc_subfield_structure.tagfield
1064     AND marc_tag_structure.frameworkcode = marc_subfield_structure.frameworkcode
1065 WHERE marc_subfield_structure.tab>=0
1066 AND marc_tag_structure.tagfield NOT IN (SELECT tagfield FROM marc_subfield_structure WHERE kohafield like 'items.%')
1067 AND marc_tag_structure.tagfield NOT IN (SELECT tagfield FROM marc_subfield_structure WHERE kohafield = 'biblioitems.itemtype')
1068 AND marc_subfield_structure.kohafield <> 'biblio.biblionumber'
1069 AND marc_subfield_structure.kohafield <>  'biblioitems.biblioitemnumber'
1070 ORDER BY marc_subfield_structure.tagfield, tagsubfield|);
1071   $rq->execute;
1072   my $data=$rq->fetchall_arrayref({});
1073   return $data;
1074 }
1075
1076 =head2 display_marc_indicators
1077
1078 =over 4
1079
1080 # field is a MARC::Field object
1081 my $display_form = C4::Koha::display_marc_indicators($field);
1082
1083 =back
1084
1085 Generate a display form of the indicators of a variable
1086 MARC field, replacing any blanks with '#'.
1087
1088 =cut
1089
1090 sub display_marc_indicators {
1091     my $field = shift;
1092     my $indicators = '';
1093     if ($field->tag() >= 10) {
1094         $indicators = $field->indicator(1) . $field->indicator(2);
1095         $indicators =~ s/ /#/g;
1096     }
1097     return $indicators;
1098 }
1099
1100 1;
1101
1102 __END__
1103
1104 =head1 AUTHOR
1105
1106 Koha Team
1107
1108 =cut