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                 &GetKohaAuthorisedValues
  51                 &GetAuthValCode
  52                 &GetManagedTagSubfields
  53
  54                 $DEBUG
  55         );
  56         $DEBUG = 0;
  57 }
  58
  59 =head1 NAME
  60
  61     C4::Koha - Perl Module containing convenience functions for Koha scripts
  62
  63 =head1 SYNOPSIS
  64
  65   use C4::Koha;
  66
  67
  68 =head1 DESCRIPTION
  69
  70     Koha.pm provides many functions for Koha scripts.
  71
  72 =head1 FUNCTIONS
  73
  74 =over 2
  75
  76 =cut
  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         my $src = shift;
 458         if ($src eq 'intranet') {
 459                 return C4::Context->config('intrahtdocs') . '/' .C4::Context->preference('template') . '/img/itemtypeimg';
 460         }
 461         else {
 462                 return C4::Context->config('opachtdocs') . '/' . C4::Context->preference('template') . '/itemtypeimg';
 463         }
 464 }
 465
 466 sub getitemtypeimagesrc {
 467          my $src = shift;
 468         if ($src eq 'intranet') {
 469                 return '/intranet-tmpl' . '/' . C4::Context->preference('template') . '/img/itemtypeimg';
 470         }
 471         else {
 472                 return '/opac-tmpl' . '/' . C4::Context->preference('template') . '/itemtypeimg';
 473         }
 474 }
 475
 476 =head2 GetPrinters
 477
 478   $printers = &GetPrinters();
 479   @queues = keys %$printers;
 480
 481 Returns information about existing printer queues.
 482
 483 C<$printers> is a reference-to-hash whose keys are the print queues
 484 defined in the printers table of the Koha database. The values are
 485 references-to-hash, whose keys are the fields in the printers table.
 486
 487 =cut
 488
 489 sub GetPrinters {
 490     my %printers;
 491     my $dbh = C4::Context->dbh;
 492     my $sth = $dbh->prepare("select * from printers");
 493     $sth->execute;
 494     while ( my $printer = $sth->fetchrow_hashref ) {
 495         $printers{ $printer->{'printqueue'} } = $printer;
 496     }
 497     return ( \%printers );
 498 }
 499
 500 =head2 GetPrinter
 501
 502 $printer = GetPrinter( $query, $printers );
 503
 504 =cut
 505
 506 sub GetPrinter ($$) {
 507     my ( $query, $printers ) = @_;    # get printer for this query from printers
 508     my $printer = $query->param('printer');
 509     my %cookie = $query->cookie('userenv');
 510     ($printer) || ( $printer = $cookie{'printer'} ) || ( $printer = '' );
 511     ( $printers->{$printer} ) || ( $printer = ( keys %$printers )[0] );
 512     return $printer;
 513 }
 514
 515 =item getnbpages
 516
 517 Returns the number of pages to display in a pagination bar, given the number
 518 of items and the number of items per page.
 519
 520 =cut
 521
 522 sub getnbpages {
 523     my ( $nb_items, $nb_items_per_page ) = @_;
 524
 525     return int( ( $nb_items - 1 ) / $nb_items_per_page ) + 1;
 526 }
 527
 528 =item getallthemes
 529
 530   (@themes) = &getallthemes('opac');
 531   (@themes) = &getallthemes('intranet');
 532
 533 Returns an array of all available themes.
 534
 535 =cut
 536
 537 sub getallthemes {
 538     my $type = shift;
 539     my $htdocs;
 540     my @themes;
 541     if ( $type eq 'intranet' ) {
 542         $htdocs = C4::Context->config('intrahtdocs');
 543     }
 544     else {
 545         $htdocs = C4::Context->config('opachtdocs');
 546     }
 547     opendir D, "$htdocs";
 548     my @dirlist = readdir D;
 549     foreach my $directory (@dirlist) {
 550         -d "$htdocs/$directory/en" and push @themes, $directory;
 551     }
 552     return @themes;
 553 }
 554
 555 sub getFacets {
 556     my $facets;
 557     if ( C4::Context->preference("marcflavour") eq "UNIMARC" ) {
 558         $facets = [
 559             {
 560                 link_value  => 'su-to',
 561                 label_value => 'Topics',
 562                 tags        =>
 563                   [ '600', '601', '602', '603', '604', '605', '606', '610' ],
 564                 subfield => 'a',
 565             },
 566             {
 567                 link_value  => 'su-geo',
 568                 label_value => 'Places',
 569                 tags        => ['651'],
 570                 subfield    => 'a',
 571             },
 572             {
 573                 link_value  => 'su-ut',
 574                 label_value => 'Titles',
 575                 tags        => [ '500', '501', '502', '503', '504', ],
 576                 subfield    => 'a',
 577             },
 578             {
 579                 link_value  => 'au',
 580                 label_value => 'Authors',
 581                 tags        => [ '700', '701', '702', ],
 582                 subfield    => 'a',
 583             },
 584             {
 585                 link_value  => 'se',
 586                 label_value => 'Series',
 587                 tags        => ['225'],
 588                 subfield    => 'a',
 589             },
 590             {
 591                 link_value  => 'branch',
 592                 label_value => 'Libraries',
 593                 tags        => [ '995', ],
 594                 subfield    => 'b',
 595                 expanded    => '1',
 596             },
 597         ];
 598     }
 599     else {
 600         $facets = [
 601             {
 602                 link_value  => 'su-to',
 603                 label_value => 'Topics',
 604                 tags        => ['650'],
 605                 subfield    => 'a',
 606             },
 607
 608             #        {
 609             #        link_value => 'su-na',
 610             #        label_value => 'People and Organizations',
 611             #        tags => ['600', '610', '611'],
 612             #        subfield => 'a',
 613             #        },
 614             {
 615                 link_value  => 'su-geo',
 616                 label_value => 'Places',
 617                 tags        => ['651'],
 618                 subfield    => 'a',
 619             },
 620             {
 621                 link_value  => 'su-ut',
 622                 label_value => 'Titles',
 623                 tags        => ['630'],
 624                 subfield    => 'a',
 625             },
 626             {
 627                 link_value  => 'au',
 628                 label_value => 'Authors',
 629                 tags        => [ '100', '110', '700', ],
 630                 subfield    => 'a',
 631             },
 632             {
 633                 link_value  => 'se',
 634                 label_value => 'Series',
 635                 tags        => [ '440', '490', ],
 636                 subfield    => 'a',
 637             },
 638             {
 639                 link_value  => 'branch',
 640                 label_value => 'Libraries',
 641                 tags        => [ '952', ],
 642                 subfield    => 'b',
 643                 expanded    => '1',
 644             },
 645         ];
 646     }
 647     return $facets;
 648 }
 649
 650 =head2 get_infos_of
 651
 652 Return a href where a key is associated to a href. You give a query, the
 653 name of the key among the fields returned by the query. If you also give as
 654 third argument the name of the value, the function returns a href of scalar.
 655
 656   my $query = '
 657 SELECT itemnumber,
 658        notforloan,
 659        barcode
 660   FROM items
 661 ';
 662
 663   # generic href of any information on the item, href of href.
 664   my $iteminfos_of = get_infos_of($query, 'itemnumber');
 665   print $iteminfos_of->{$itemnumber}{barcode};
 666
 667   # specific information, href of scalar
 668   my $barcode_of_item = get_infos_of($query, 'itemnumber', 'barcode');
 669   print $barcode_of_item->{$itemnumber};
 670
 671 =cut
 672
 673 sub get_infos_of {
 674     my ( $query, $key_name, $value_name ) = @_;
 675
 676     my $dbh = C4::Context->dbh;
 677
 678     my $sth = $dbh->prepare($query);
 679     $sth->execute();
 680
 681     my %infos_of;
 682     while ( my $row = $sth->fetchrow_hashref ) {
 683         if ( defined $value_name ) {
 684             $infos_of{ $row->{$key_name} } = $row->{$value_name};
 685         }
 686         else {
 687             $infos_of{ $row->{$key_name} } = $row;
 688         }
 689     }
 690     $sth->finish;
 691
 692     return \%infos_of;
 693 }
 694
 695 =head2 get_notforloan_label_of
 696
 697   my $notforloan_label_of = get_notforloan_label_of();
 698
 699 Each authorised value of notforloan (information available in items and
 700 itemtypes) is link to a single label.
 701
 702 Returns a href where keys are authorised values and values are corresponding
 703 labels.
 704
 705   foreach my $authorised_value (keys %{$notforloan_label_of}) {
 706     printf(
 707         "authorised_value: %s => %s\n",
 708         $authorised_value,
 709         $notforloan_label_of->{$authorised_value}
 710     );
 711   }
 712
 713 =cut
 714
 715 # FIXME - why not use GetAuthorisedValues ??
 716 #
 717 sub get_notforloan_label_of {
 718     my $dbh = C4::Context->dbh;
 719
 720     my $query = '
 721 SELECT authorised_value
 722   FROM marc_subfield_structure
 723   WHERE kohafield = \'items.notforloan\'
 724   LIMIT 0, 1
 725 ';
 726     my $sth = $dbh->prepare($query);
 727     $sth->execute();
 728     my ($statuscode) = $sth->fetchrow_array();
 729
 730     $query = '
 731 SELECT lib,
 732        authorised_value
 733   FROM authorised_values
 734   WHERE category = ?
 735 ';
 736     $sth = $dbh->prepare($query);
 737     $sth->execute($statuscode);
 738     my %notforloan_label_of;
 739     while ( my $row = $sth->fetchrow_hashref ) {
 740         $notforloan_label_of{ $row->{authorised_value} } = $row->{lib};
 741     }
 742     $sth->finish;
 743
 744     return \%notforloan_label_of;
 745 }
 746
 747 sub displayServers {
 748     my ( $position, $type ) = @_;
 749     my $dbh    = C4::Context->dbh;
 750     my $strsth = "SELECT * FROM z3950servers where 1";
 751     $strsth .= " AND position=\"$position\"" if ($position);
 752     $strsth .= " AND type=\"$type\""         if ($type);
 753     my $rq = $dbh->prepare($strsth);
 754     $rq->execute;
 755     my @primaryserverloop;
 756
 757     while ( my $data = $rq->fetchrow_hashref ) {
 758         my %cell;
 759         $cell{label} = $data->{'description'};
 760         $cell{id}    = $data->{'name'};
 761         $cell{value} =
 762             $data->{host}
 763           . ( $data->{port} ? ":" . $data->{port} : "" ) . "/"
 764           . $data->{database}
 765           if ( $data->{host} );
 766         $cell{checked} = $data->{checked};
 767         push @primaryserverloop,
 768           {
 769             label => $data->{description},
 770             id    => $data->{name},
 771             name  => "server",
 772             value => $data->{host} . ":"
 773               . $data->{port} . "/"
 774               . $data->{database},
 775             encoding   => ($data->{encoding}?$data->{encoding}:"iso-5426"),
 776             checked    => "checked",
 777             icon       => $data->{icon},
 778             zed        => $data->{type} eq 'zed',
 779             opensearch => $data->{type} eq 'opensearch'
 780           };
 781     }
 782     return \@primaryserverloop;
 783 }
 784
 785 sub displaySecondaryServers {
 786
 787 #       my $secondary_servers_loop = [
 788 #               { inner_sup_servers_loop => [
 789 #               {label => "Google", id=>"GOOG", value=>"google",icon => "google.ico",opensearch => "1"},
 790 #               {label => "Yahoo", id=>"YAH", value=>"yahoo", icon =>"yahoo.ico", zed => "1"},
 791 #               {label => "Worldcat", id=>"WCT", value=>"worldcat", icon => "worldcat.gif", zed => "1"},
 792 #               {label => "Library of Congress", id=>"LOC", name=> "server", value=>"z3950.loc.gov:7090/Voyager", icon =>"loc.ico", zed => "1"},
 793 #       ],
 794 #       },
 795 #       ];
 796     return;    #$secondary_servers_loop;
 797 }
 798
 799 =head2 GetAuthValCode
 800
 801 $authvalcode = GetAuthValCode($kohafield,$frameworkcode);
 802
 803 =cut
 804
 805 sub GetAuthValCode {
 806         my ($kohafield,$fwcode) = @_;
 807         my $dbh = C4::Context->dbh;
 808         $fwcode='' unless $fwcode;
 809         my $sth = $dbh->prepare('select authorised_value from marc_subfield_structure where kohafield=? and frameworkcode=?');
 810         $sth->execute($kohafield,$fwcode);
 811         my ($authvalcode) = $sth->fetchrow_array;
 812         return $authvalcode;
 813 }
 814
 815 =head2 GetAuthorisedValues
 816
 817 $authvalues = GetAuthorisedValues($category);
 818
 819 this function get all authorised values from 'authosied_value' table into a reference to array which
 820 each value containt an hashref.
 821
 822 Set C<$category> on input args if you want to limits your query to this one. This params is not mandatory.
 823
 824 =cut
 825
 826 sub GetAuthorisedValues {
 827     my ($category,$selected) = @_;
 828         my $count = 0;
 829         my @results;
 830     my $dbh      = C4::Context->dbh;
 831     my $query    = "SELECT * FROM authorised_values";
 832     $query .= " WHERE category = '" . $category . "'" if $category;
 833
 834     my $sth = $dbh->prepare($query);
 835     $sth->execute;
 836         while (my $data=$sth->fetchrow_hashref) {
 837                 if ($selected eq $data->{'authorised_value'} ) {
 838                         $data->{'selected'} = 1;
 839                 }
 840                 $results[$count] = $data;
 841                 $count++;
 842         }
 843     #my $data = $sth->fetchall_arrayref({});
 844     return \@results; #$data;
 845 }
 846
 847 =head2 GetKohaAuthorisedValues
 848
 849         Takes $dbh , $kohafield as parameters.
 850         returns hashref of authvalCode => liblibrarian
 851         or undef if no authvals defined for kohafield.
 852
 853 =cut
 854
 855 sub GetKohaAuthorisedValues {
 856   my ($kohafield,$fwcode) = @_;
 857   $fwcode='' unless $fwcode;
 858   my %values;
 859   my $dbh = C4::Context->dbh;
 860   my $avcode = GetAuthValCode($kohafield,$fwcode);
 861   if ($avcode) {
 862     my $sth = $dbh->prepare("select authorised_value, lib from authorised_values where category=? ");
 863     $sth->execute($avcode);
 864         while ( my ($val, $lib) = $sth->fetchrow_array ) {
 865                 $values{$val}= $lib;
 866         }
 867   }
 868   return \%values;
 869 }
 870
 871 =head2 GetManagedTagSubfields
 872
 873 =over 4
 874
 875 $res = GetManagedTagSubfields();
 876
 877 =back
 878
 879 Returns a reference to a big hash of hash, with the Marc structure fro the given frameworkcode
 880
 881 NOTE: This function is used only by the (incomplete) bulk editing feature.  Since
 882 that feature currently does not deal with items and biblioitems changes
 883 correctly, those tags are specifically excluded from the list prepared
 884 by this function.
 885
 886 For future reference, if a bulk item editing feature is implemented at some point, it
 887 needs some design thought -- for example, circulation status fields should not
 888 be changed willy-nilly.
 889
 890 =cut
 891
 892 sub GetManagedTagSubfields{
 893   my $dbh=C4::Context->dbh;
 894   my $rq=$dbh->prepare(qq|
 895 SELECT
 896   DISTINCT CONCAT( marc_subfield_structure.tagfield, tagsubfield ) AS tagsubfield,
 897   marc_subfield_structure.liblibrarian as subfielddesc,
 898   marc_tag_structure.liblibrarian as tagdesc
 899 FROM marc_subfield_structure
 900   LEFT JOIN marc_tag_structure
 901     ON marc_tag_structure.tagfield = marc_subfield_structure.tagfield
 902     AND marc_tag_structure.frameworkcode = marc_subfield_structure.frameworkcode
 903 WHERE marc_subfield_structure.tab>=0
 904 AND marc_tag_structure.tagfield NOT IN (SELECT tagfield FROM marc_subfield_structure WHERE kohafield like 'items.%')
 905 AND marc_tag_structure.tagfield NOT IN (SELECT tagfield FROM marc_subfield_structure WHERE kohafield = 'biblioitems.itemtype')
 906 AND marc_subfield_structure.kohafield <> 'biblio.biblionumber'
 907 AND marc_subfield_structure.kohafield <>  'biblioitems.biblioitemnumber'
 908 ORDER BY marc_subfield_structure.tagfield, tagsubfield|);
 909   $rq->execute;
 910   my $data=$rq->fetchall_arrayref({});
 911   return $data;
 912 }
 913
 914 1;
 915
 916 __END__
 917
 918 =head1 AUTHOR
 919
 920 Koha Team
 921
 922 =cut