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