C4/Koha.pm

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