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 =head2 GetPrinters
 483
 484   $printers = &GetPrinters();
 485   @queues = keys %$printers;
 486
 487 Returns information about existing printer queues.
 488
 489 C<$printers> is a reference-to-hash whose keys are the print queues
 490 defined in the printers table of the Koha database. The values are
 491 references-to-hash, whose keys are the fields in the printers table.
 492
 493 =cut
 494
 495 sub GetPrinters {
 496     my %printers;
 497     my $dbh = C4::Context->dbh;
 498     my $sth = $dbh->prepare("select * from printers");
 499     $sth->execute;
 500     while ( my $printer = $sth->fetchrow_hashref ) {
 501         $printers{ $printer->{'printqueue'} } = $printer;
 502     }
 503     return ( \%printers );
 504 }
 505
 506 =head2 GetPrinter
 507
 508 $printer = GetPrinter( $query, $printers );
 509
 510 =cut
 511
 512 sub GetPrinter ($$) {
 513     my ( $query, $printers ) = @_;    # get printer for this query from printers
 514     my $printer = $query->param('printer');
 515     my %cookie = $query->cookie('userenv');
 516     ($printer) || ( $printer = $cookie{'printer'} ) || ( $printer = '' );
 517     ( $printers->{$printer} ) || ( $printer = ( keys %$printers )[0] );
 518     return $printer;
 519 }
 520
 521 =item getnbpages
 522
 523 Returns the number of pages to display in a pagination bar, given the number
 524 of items and the number of items per page.
 525
 526 =cut
 527
 528 sub getnbpages {
 529     my ( $nb_items, $nb_items_per_page ) = @_;
 530
 531     return int( ( $nb_items - 1 ) / $nb_items_per_page ) + 1;
 532 }
 533
 534 =item getallthemes
 535
 536   (@themes) = &getallthemes('opac');
 537   (@themes) = &getallthemes('intranet');
 538
 539 Returns an array of all available themes.
 540
 541 =cut
 542
 543 sub getallthemes {
 544     my $type = shift;
 545     my $htdocs;
 546     my @themes;
 547     if ( $type eq 'intranet' ) {
 548         $htdocs = C4::Context->config('intrahtdocs');
 549     }
 550     else {
 551         $htdocs = C4::Context->config('opachtdocs');
 552     }
 553     opendir D, "$htdocs";
 554     my @dirlist = readdir D;
 555     foreach my $directory (@dirlist) {
 556         -d "$htdocs/$directory/en" and push @themes, $directory;
 557     }
 558     return @themes;
 559 }
 560
 561 sub getFacets {
 562     my $facets;
 563     if ( C4::Context->preference("marcflavour") eq "UNIMARC" ) {
 564         $facets = [
 565             {
 566                 link_value  => 'su-to',
 567                 label_value => 'Topics',
 568                 tags        =>
 569                   [ '600', '601', '602', '603', '604', '605', '606', '610' ],
 570                 subfield => 'a',
 571             },
 572             {
 573                 link_value  => 'su-geo',
 574                 label_value => 'Places',
 575                 tags        => ['651'],
 576                 subfield    => 'a',
 577             },
 578             {
 579                 link_value  => 'su-ut',
 580                 label_value => 'Titles',
 581                 tags        => [ '500', '501', '502', '503', '504', ],
 582                 subfield    => 'a',
 583             },
 584             {
 585                 link_value  => 'au',
 586                 label_value => 'Authors',
 587                 tags        => [ '700', '701', '702', ],
 588                 subfield    => 'a',
 589             },
 590             {
 591                 link_value  => 'se',
 592                 label_value => 'Series',
 593                 tags        => ['225'],
 594                 subfield    => 'a',
 595             },
 596             ];
 597
 598             my $library_facet;
 599
 600             $library_facet = {
 601                 link_value  => 'branch',
 602                 label_value => 'Libraries',
 603                 tags        => [ '995', ],
 604                 subfield    => 'b',
 605                 expanded    => '1',
 606             };
 607             push @$facets, $library_facet unless C4::Context->preference("singleBranchMode");
 608     }
 609     else {
 610         $facets = [
 611             {
 612                 link_value  => 'su-to',
 613                 label_value => 'Topics',
 614                 tags        => ['650'],
 615                 subfield    => 'a',
 616             },
 617
 618             #        {
 619             #        link_value => 'su-na',
 620             #        label_value => 'People and Organizations',
 621             #        tags => ['600', '610', '611'],
 622             #        subfield => 'a',
 623             #        },
 624             {
 625                 link_value  => 'su-geo',
 626                 label_value => 'Places',
 627                 tags        => ['651'],
 628                 subfield    => 'a',
 629             },
 630             {
 631                 link_value  => 'su-ut',
 632                 label_value => 'Titles',
 633                 tags        => ['630'],
 634                 subfield    => 'a',
 635             },
 636             {
 637                 link_value  => 'au',
 638                 label_value => 'Authors',
 639                 tags        => [ '100', '110', '700', ],
 640                 subfield    => 'a',
 641             },
 642             {
 643                 link_value  => 'se',
 644                 label_value => 'Series',
 645                 tags        => [ '440', '490', ],
 646                 subfield    => 'a',
 647             },
 648             ];
 649             my $library_facet;
 650             $library_facet = {
 651                 link_value  => 'branch',
 652                 label_value => 'Libraries',
 653                 tags        => [ '952', ],
 654                 subfield    => 'b',
 655                 expanded    => '1',
 656             };
 657             push @$facets, $library_facet unless C4::Context->preference("singleBranchMode");
 658     }
 659     return $facets;
 660 }
 661
 662 =head2 get_infos_of
 663
 664 Return a href where a key is associated to a href. You give a query, the
 665 name of the key among the fields returned by the query. If you also give as
 666 third argument the name of the value, the function returns a href of scalar.
 667
 668   my $query = '
 669 SELECT itemnumber,
 670        notforloan,
 671        barcode
 672   FROM items
 673 ';
 674
 675   # generic href of any information on the item, href of href.
 676   my $iteminfos_of = get_infos_of($query, 'itemnumber');
 677   print $iteminfos_of->{$itemnumber}{barcode};
 678
 679   # specific information, href of scalar
 680   my $barcode_of_item = get_infos_of($query, 'itemnumber', 'barcode');
 681   print $barcode_of_item->{$itemnumber};
 682
 683 =cut
 684
 685 sub get_infos_of {
 686     my ( $query, $key_name, $value_name ) = @_;
 687
 688     my $dbh = C4::Context->dbh;
 689
 690     my $sth = $dbh->prepare($query);
 691     $sth->execute();
 692
 693     my %infos_of;
 694     while ( my $row = $sth->fetchrow_hashref ) {
 695         if ( defined $value_name ) {
 696             $infos_of{ $row->{$key_name} } = $row->{$value_name};
 697         }
 698         else {
 699             $infos_of{ $row->{$key_name} } = $row;
 700         }
 701     }
 702     $sth->finish;
 703
 704     return \%infos_of;
 705 }
 706
 707 =head2 get_notforloan_label_of
 708
 709   my $notforloan_label_of = get_notforloan_label_of();
 710
 711 Each authorised value of notforloan (information available in items and
 712 itemtypes) is link to a single label.
 713
 714 Returns a href where keys are authorised values and values are corresponding
 715 labels.
 716
 717   foreach my $authorised_value (keys %{$notforloan_label_of}) {
 718     printf(
 719         "authorised_value: %s => %s\n",
 720         $authorised_value,
 721         $notforloan_label_of->{$authorised_value}
 722     );
 723   }
 724
 725 =cut
 726
 727 # FIXME - why not use GetAuthorisedValues ??
 728 #
 729 sub get_notforloan_label_of {
 730     my $dbh = C4::Context->dbh;
 731
 732     my $query = '
 733 SELECT authorised_value
 734   FROM marc_subfield_structure
 735   WHERE kohafield = \'items.notforloan\'
 736   LIMIT 0, 1
 737 ';
 738     my $sth = $dbh->prepare($query);
 739     $sth->execute();
 740     my ($statuscode) = $sth->fetchrow_array();
 741
 742     $query = '
 743 SELECT lib,
 744        authorised_value
 745   FROM authorised_values
 746   WHERE category = ?
 747 ';
 748     $sth = $dbh->prepare($query);
 749     $sth->execute($statuscode);
 750     my %notforloan_label_of;
 751     while ( my $row = $sth->fetchrow_hashref ) {
 752         $notforloan_label_of{ $row->{authorised_value} } = $row->{lib};
 753     }
 754     $sth->finish;
 755
 756     return \%notforloan_label_of;
 757 }
 758
 759 sub displayServers {
 760     my ( $position, $type ) = @_;
 761     my $dbh    = C4::Context->dbh;
 762     my $strsth = "SELECT * FROM z3950servers where 1";
 763     $strsth .= " AND position=\"$position\"" if ($position);
 764     $strsth .= " AND type=\"$type\""         if ($type);
 765     my $rq = $dbh->prepare($strsth);
 766     $rq->execute;
 767     my @primaryserverloop;
 768
 769     while ( my $data = $rq->fetchrow_hashref ) {
 770         my %cell;
 771         $cell{label} = $data->{'description'};
 772         $cell{id}    = $data->{'name'};
 773         $cell{value} =
 774             $data->{host}
 775           . ( $data->{port} ? ":" . $data->{port} : "" ) . "/"
 776           . $data->{database}
 777           if ( $data->{host} );
 778         $cell{checked} = $data->{checked};
 779         push @primaryserverloop,
 780           {
 781             label => $data->{description},
 782             id    => $data->{name},
 783             name  => "server",
 784             value => $data->{host} . ":"
 785               . $data->{port} . "/"
 786               . $data->{database},
 787             encoding   => ($data->{encoding}?$data->{encoding}:"iso-5426"),
 788             checked    => "checked",
 789             icon       => $data->{icon},
 790             zed        => $data->{type} eq 'zed',
 791             opensearch => $data->{type} eq 'opensearch'
 792           };
 793     }
 794     return \@primaryserverloop;
 795 }
 796
 797 sub displaySecondaryServers {
 798
 799 #       my $secondary_servers_loop = [
 800 #               { inner_sup_servers_loop => [
 801 #               {label => "Google", id=>"GOOG", value=>"google",icon => "google.ico",opensearch => "1"},
 802 #               {label => "Yahoo", id=>"YAH", value=>"yahoo", icon =>"yahoo.ico", zed => "1"},
 803 #               {label => "Worldcat", id=>"WCT", value=>"worldcat", icon => "worldcat.gif", zed => "1"},
 804 #               {label => "Library of Congress", id=>"LOC", name=> "server", value=>"z3950.loc.gov:7090/Voyager", icon =>"loc.ico", zed => "1"},
 805 #       ],
 806 #       },
 807 #       ];
 808     return;    #$secondary_servers_loop;
 809 }
 810
 811 =head2 GetAuthValCode
 812
 813 $authvalcode = GetAuthValCode($kohafield,$frameworkcode);
 814
 815 =cut
 816
 817 sub GetAuthValCode {
 818         my ($kohafield,$fwcode) = @_;
 819         my $dbh = C4::Context->dbh;
 820         $fwcode='' unless $fwcode;
 821         my $sth = $dbh->prepare('select authorised_value from marc_subfield_structure where kohafield=? and frameworkcode=?');
 822         $sth->execute($kohafield,$fwcode);
 823         my ($authvalcode) = $sth->fetchrow_array;
 824         return $authvalcode;
 825 }
 826
 827 =head2 GetAuthorisedValues
 828
 829 $authvalues = GetAuthorisedValues($category);
 830
 831 this function get all authorised values from 'authosied_value' table into a reference to array which
 832 each value containt an hashref.
 833
 834 Set C<$category> on input args if you want to limits your query to this one. This params is not mandatory.
 835
 836 =cut
 837
 838 sub GetAuthorisedValues {
 839     my ($category,$selected) = @_;
 840         my $count = 0;
 841         my @results;
 842     my $dbh      = C4::Context->dbh;
 843     my $query    = "SELECT * FROM authorised_values";
 844     $query .= " WHERE category = '" . $category . "'" if $category;
 845
 846     my $sth = $dbh->prepare($query);
 847     $sth->execute;
 848         while (my $data=$sth->fetchrow_hashref) {
 849                 if ($selected eq $data->{'authorised_value'} ) {
 850                         $data->{'selected'} = 1;
 851                 }
 852                 $results[$count] = $data;
 853                 $count++;
 854         }
 855     #my $data = $sth->fetchall_arrayref({});
 856     return \@results; #$data;
 857 }
 858
 859 =head2 GetKohaAuthorisedValues
 860
 861         Takes $kohafield, $fwcode as parameters.
 862         Returns hashref of Code => description
 863         Returns undef
 864           if no authorised value category is defined for the kohafield.
 865
 866 =cut
 867
 868 sub GetKohaAuthorisedValues {
 869   my ($kohafield,$fwcode,$codedvalue) = @_;
 870   $fwcode='' unless $fwcode;
 871   my %values;
 872   my $dbh = C4::Context->dbh;
 873   my $avcode = GetAuthValCode($kohafield,$fwcode);
 874   if ($avcode) {
 875         my $sth = $dbh->prepare("select authorised_value, lib from authorised_values where category=? ");
 876         $sth->execute($avcode);
 877         while ( my ($val, $lib) = $sth->fetchrow_array ) {
 878                 $values{$val}= $lib;
 879         }
 880         return \%values;
 881   } else {
 882         return undef;
 883   }
 884 }
 885
 886 =head2 GetManagedTagSubfields
 887
 888 =over 4
 889
 890 $res = GetManagedTagSubfields();
 891
 892 =back
 893
 894 Returns a reference to a big hash of hash, with the Marc structure fro the given frameworkcode
 895
 896 NOTE: This function is used only by the (incomplete) bulk editing feature.  Since
 897 that feature currently does not deal with items and biblioitems changes
 898 correctly, those tags are specifically excluded from the list prepared
 899 by this function.
 900
 901 For future reference, if a bulk item editing feature is implemented at some point, it
 902 needs some design thought -- for example, circulation status fields should not
 903 be changed willy-nilly.
 904
 905 =cut
 906
 907 sub GetManagedTagSubfields{
 908   my $dbh=C4::Context->dbh;
 909   my $rq=$dbh->prepare(qq|
 910 SELECT
 911   DISTINCT CONCAT( marc_subfield_structure.tagfield, tagsubfield ) AS tagsubfield,
 912   marc_subfield_structure.liblibrarian as subfielddesc,
 913   marc_tag_structure.liblibrarian as tagdesc
 914 FROM marc_subfield_structure
 915   LEFT JOIN marc_tag_structure
 916     ON marc_tag_structure.tagfield = marc_subfield_structure.tagfield
 917     AND marc_tag_structure.frameworkcode = marc_subfield_structure.frameworkcode
 918 WHERE marc_subfield_structure.tab>=0
 919 AND marc_tag_structure.tagfield NOT IN (SELECT tagfield FROM marc_subfield_structure WHERE kohafield like 'items.%')
 920 AND marc_tag_structure.tagfield NOT IN (SELECT tagfield FROM marc_subfield_structure WHERE kohafield = 'biblioitems.itemtype')
 921 AND marc_subfield_structure.kohafield <> 'biblio.biblionumber'
 922 AND marc_subfield_structure.kohafield <>  'biblioitems.biblioitemnumber'
 923 ORDER BY marc_subfield_structure.tagfield, tagsubfield|);
 924   $rq->execute;
 925   my $data=$rq->fetchall_arrayref({});
 926   return $data;
 927 }
 928
 929 =head2 str_to_base64
 930
 931 =over 4
 932
 933 my $base64 = str_to_base64($string_containing_unicode);
 934
 935 =back
 936
 937 Get a Base64 version of a string that is in UTF-8.  This
 938 function can be used to convert an arbitrary coded value
 939 (like a branch code) into a form that can be safely concatenated
 940 with similarly encoded values for a HTML form input name, as
 941 in admin/issuingrules.pl.
 942
 943 =cut
 944
 945 sub str_to_base64 {
 946     my $in = shift;
 947     return encode_base64(encode("UTF-8", $in), '');
 948 }
 949
 950 =head2 base64_to_str
 951
 952 =over 4
 953
 954 my $base64 = base64_to_str($string_containing_unicode);
 955
 956 =back
 957
 958 Converse of C<str_to_base64()>.
 959
 960 =cut
 961
 962 sub base64_to_str {
 963     my $in = shift;
 964     return decode("UTF-8", decode_base64($in));
 965 }
 966
 967 1;
 968
 969 __END__
 970
 971 =head1 AUTHOR
 972
 973 Koha Team
 974
 975 =cut