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