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 =back
 922
 923 Returns a reference to a big hash of hash, with the Marc structure fro the given frameworkcode
 924
 925 NOTE: This function is used only by the (incomplete) bulk editing feature.  Since
 926 that feature currently does not deal with items and biblioitems changes
 927 correctly, those tags are specifically excluded from the list prepared
 928 by this function.
 929
 930 For future reference, if a bulk item editing feature is implemented at some point, it
 931 needs some design thought -- for example, circulation status fields should not
 932 be changed willy-nilly.
 933
 934 =cut
 935
 936 sub GetManagedTagSubfields{
 937   my $dbh=C4::Context->dbh;
 938   my $rq=$dbh->prepare(qq|
 939 SELECT
 940   DISTINCT CONCAT( marc_subfield_structure.tagfield, tagsubfield ) AS tagsubfield,
 941   marc_subfield_structure.liblibrarian as subfielddesc,
 942   marc_tag_structure.liblibrarian as tagdesc
 943 FROM marc_subfield_structure
 944   LEFT JOIN marc_tag_structure
 945     ON marc_tag_structure.tagfield = marc_subfield_structure.tagfield
 946     AND marc_tag_structure.frameworkcode = marc_subfield_structure.frameworkcode
 947 WHERE marc_subfield_structure.tab>=0
 948 AND marc_tag_structure.tagfield NOT IN (SELECT tagfield FROM marc_subfield_structure WHERE kohafield like 'items.%')
 949 AND marc_tag_structure.tagfield NOT IN (SELECT tagfield FROM marc_subfield_structure WHERE kohafield = 'biblioitems.itemtype')
 950 AND marc_subfield_structure.kohafield <> 'biblio.biblionumber'
 951 AND marc_subfield_structure.kohafield <>  'biblioitems.biblioitemnumber'
 952 ORDER BY marc_subfield_structure.tagfield, tagsubfield|);
 953   $rq->execute;
 954   my $data=$rq->fetchall_arrayref({});
 955   return $data;
 956 }
 957
 958 1;
 959
 960 __END__
 961
 962 =head1 AUTHOR
 963
 964 Koha Team
 965
 966 =cut