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