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