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