C4/Koha.pm

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