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
 592             my $library_facet;
 593
 594             $library_facet = {
 595                 link_value  => 'branch',
 596                 label_value => 'Libraries',
 597                 tags        => [ '995', ],
 598                 subfield    => 'b',
 599                 expanded    => '1',
 600             };
 601             push @$facets, $library_facet unless C4::Context->preference("singleBranchMode");
 602     }
 603     else {
 604         $facets = [
 605             {
 606                 link_value  => 'su-to',
 607                 label_value => 'Topics',
 608                 tags        => ['650'],
 609                 subfield    => 'a',
 610             },
 611
 612             #        {
 613             #        link_value => 'su-na',
 614             #        label_value => 'People and Organizations',
 615             #        tags => ['600', '610', '611'],
 616             #        subfield => 'a',
 617             #        },
 618             {
 619                 link_value  => 'su-geo',
 620                 label_value => 'Places',
 621                 tags        => ['651'],
 622                 subfield    => 'a',
 623             },
 624             {
 625                 link_value  => 'su-ut',
 626                 label_value => 'Titles',
 627                 tags        => ['630'],
 628                 subfield    => 'a',
 629             },
 630             {
 631                 link_value  => 'au',
 632                 label_value => 'Authors',
 633                 tags        => [ '100', '110', '700', ],
 634                 subfield    => 'a',
 635             },
 636             {
 637                 link_value  => 'se',
 638                 label_value => 'Series',
 639                 tags        => [ '440', '490', ],
 640                 subfield    => 'a',
 641             },
 642             ];
 643             my $library_facet;
 644             $library_facet = {
 645                 link_value  => 'branch',
 646                 label_value => 'Libraries',
 647                 tags        => [ '952', ],
 648                 subfield    => 'b',
 649                 expanded    => '1',
 650             };
 651             push @$facets, $library_facet unless C4::Context->preference("singleBranchMode");
 652     }
 653     return $facets;
 654 }
 655
 656 =head2 get_infos_of
 657
 658 Return a href where a key is associated to a href. You give a query, the
 659 name of the key among the fields returned by the query. If you also give as
 660 third argument the name of the value, the function returns a href of scalar.
 661
 662   my $query = '
 663 SELECT itemnumber,
 664        notforloan,
 665        barcode
 666   FROM items
 667 ';
 668
 669   # generic href of any information on the item, href of href.
 670   my $iteminfos_of = get_infos_of($query, 'itemnumber');
 671   print $iteminfos_of->{$itemnumber}{barcode};
 672
 673   # specific information, href of scalar
 674   my $barcode_of_item = get_infos_of($query, 'itemnumber', 'barcode');
 675   print $barcode_of_item->{$itemnumber};
 676
 677 =cut
 678
 679 sub get_infos_of {
 680     my ( $query, $key_name, $value_name ) = @_;
 681
 682     my $dbh = C4::Context->dbh;
 683
 684     my $sth = $dbh->prepare($query);
 685     $sth->execute();
 686
 687     my %infos_of;
 688     while ( my $row = $sth->fetchrow_hashref ) {
 689         if ( defined $value_name ) {
 690             $infos_of{ $row->{$key_name} } = $row->{$value_name};
 691         }
 692         else {
 693             $infos_of{ $row->{$key_name} } = $row;
 694         }
 695     }
 696     $sth->finish;
 697
 698     return \%infos_of;
 699 }
 700
 701 =head2 get_notforloan_label_of
 702
 703   my $notforloan_label_of = get_notforloan_label_of();
 704
 705 Each authorised value of notforloan (information available in items and
 706 itemtypes) is link to a single label.
 707
 708 Returns a href where keys are authorised values and values are corresponding
 709 labels.
 710
 711   foreach my $authorised_value (keys %{$notforloan_label_of}) {
 712     printf(
 713         "authorised_value: %s => %s\n",
 714         $authorised_value,
 715         $notforloan_label_of->{$authorised_value}
 716     );
 717   }
 718
 719 =cut
 720
 721 # FIXME - why not use GetAuthorisedValues ??
 722 #
 723 sub get_notforloan_label_of {
 724     my $dbh = C4::Context->dbh;
 725
 726     my $query = '
 727 SELECT authorised_value
 728   FROM marc_subfield_structure
 729   WHERE kohafield = \'items.notforloan\'
 730   LIMIT 0, 1
 731 ';
 732     my $sth = $dbh->prepare($query);
 733     $sth->execute();
 734     my ($statuscode) = $sth->fetchrow_array();
 735
 736     $query = '
 737 SELECT lib,
 738        authorised_value
 739   FROM authorised_values
 740   WHERE category = ?
 741 ';
 742     $sth = $dbh->prepare($query);
 743     $sth->execute($statuscode);
 744     my %notforloan_label_of;
 745     while ( my $row = $sth->fetchrow_hashref ) {
 746         $notforloan_label_of{ $row->{authorised_value} } = $row->{lib};
 747     }
 748     $sth->finish;
 749
 750     return \%notforloan_label_of;
 751 }
 752
 753 sub displayServers {
 754     my ( $position, $type ) = @_;
 755     my $dbh    = C4::Context->dbh;
 756     my $strsth = "SELECT * FROM z3950servers where 1";
 757     $strsth .= " AND position=\"$position\"" if ($position);
 758     $strsth .= " AND type=\"$type\""         if ($type);
 759     my $rq = $dbh->prepare($strsth);
 760     $rq->execute;
 761     my @primaryserverloop;
 762
 763     while ( my $data = $rq->fetchrow_hashref ) {
 764         my %cell;
 765         $cell{label} = $data->{'description'};
 766         $cell{id}    = $data->{'name'};
 767         $cell{value} =
 768             $data->{host}
 769           . ( $data->{port} ? ":" . $data->{port} : "" ) . "/"
 770           . $data->{database}
 771           if ( $data->{host} );
 772         $cell{checked} = $data->{checked};
 773         push @primaryserverloop,
 774           {
 775             label => $data->{description},
 776             id    => $data->{name},
 777             name  => "server",
 778             value => $data->{host} . ":"
 779               . $data->{port} . "/"
 780               . $data->{database},
 781             encoding   => ($data->{encoding}?$data->{encoding}:"iso-5426"),
 782             checked    => "checked",
 783             icon       => $data->{icon},
 784             zed        => $data->{type} eq 'zed',
 785             opensearch => $data->{type} eq 'opensearch'
 786           };
 787     }
 788     return \@primaryserverloop;
 789 }
 790
 791 sub displaySecondaryServers {
 792
 793 #       my $secondary_servers_loop = [
 794 #               { inner_sup_servers_loop => [
 795 #               {label => "Google", id=>"GOOG", value=>"google",icon => "google.ico",opensearch => "1"},
 796 #               {label => "Yahoo", id=>"YAH", value=>"yahoo", icon =>"yahoo.ico", zed => "1"},
 797 #               {label => "Worldcat", id=>"WCT", value=>"worldcat", icon => "worldcat.gif", zed => "1"},
 798 #               {label => "Library of Congress", id=>"LOC", name=> "server", value=>"z3950.loc.gov:7090/Voyager", icon =>"loc.ico", zed => "1"},
 799 #       ],
 800 #       },
 801 #       ];
 802     return;    #$secondary_servers_loop;
 803 }
 804
 805 =head2 GetAuthValCode
 806
 807 $authvalcode = GetAuthValCode($kohafield,$frameworkcode);
 808
 809 =cut
 810
 811 sub GetAuthValCode {
 812         my ($kohafield,$fwcode) = @_;
 813         my $dbh = C4::Context->dbh;
 814         $fwcode='' unless $fwcode;
 815         my $sth = $dbh->prepare('select authorised_value from marc_subfield_structure where kohafield=? and frameworkcode=?');
 816         $sth->execute($kohafield,$fwcode);
 817         my ($authvalcode) = $sth->fetchrow_array;
 818         return $authvalcode;
 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,$selected) = @_;
 834         my $count = 0;
 835         my @results;
 836     my $dbh      = C4::Context->dbh;
 837     my $query    = "SELECT * FROM authorised_values";
 838     $query .= " WHERE category = '" . $category . "'" if $category;
 839
 840     my $sth = $dbh->prepare($query);
 841     $sth->execute;
 842         while (my $data=$sth->fetchrow_hashref) {
 843                 if ($selected eq $data->{'authorised_value'} ) {
 844                         $data->{'selected'} = 1;
 845                 }
 846                 $results[$count] = $data;
 847                 $count++;
 848         }
 849     #my $data = $sth->fetchall_arrayref({});
 850     return \@results; #$data;
 851 }
 852
 853 =head2 GetKohaAuthorisedValues
 854
 855         Takes $kohafield, $fwcode, $value as parameters.
 856         If C<$codedvalue> is supplied, returns scalar authorised value description.
 857         If C<$codedvalue> is undefined, returns hashref of Code => description
 858         Returns undef
 859           if no authorised value category is defined for the kohafield.
 860       or no authorised value is defined for C<$codedvalue> .
 861
 862 =cut
 863
 864 sub GetKohaAuthorisedValues {
 865   my ($kohafield,$fwcode,$codedvalue) = @_;
 866   $fwcode='' unless $fwcode;
 867   my %values;
 868   my $dbh = C4::Context->dbh;
 869   my $avcode = GetAuthValCode($kohafield,$fwcode);
 870   if ($avcode) {
 871         if($codedvalue || ($codedvalue==0)) {
 872                 my $sth = $dbh->prepare("select lib from authorised_values where category=? and authorised_value=? ");
 873         $sth->execute($avcode,$codedvalue);
 874                 my ($avdesc) = $sth->fetchrow_array;
 875                 return $avdesc;
 876         } else {
 877                 my $sth = $dbh->prepare("select authorised_value, lib from authorised_values where category=? ");
 878         $sth->execute($avcode);
 879                 while ( my ($val, $lib) = $sth->fetchrow_array ) {
 880                         $values{$val}= $lib;
 881                 }
 882         return \%values;
 883         }
 884   } else {
 885         return undef;
 886 }
 887 }
 888
 889 =head2 GetManagedTagSubfields
 890
 891 =over 4
 892
 893 $res = GetManagedTagSubfields();
 894
 895 =back
 896
 897 Returns a reference to a big hash of hash, with the Marc structure fro the given frameworkcode
 898
 899 NOTE: This function is used only by the (incomplete) bulk editing feature.  Since
 900 that feature currently does not deal with items and biblioitems changes
 901 correctly, those tags are specifically excluded from the list prepared
 902 by this function.
 903
 904 For future reference, if a bulk item editing feature is implemented at some point, it
 905 needs some design thought -- for example, circulation status fields should not
 906 be changed willy-nilly.
 907
 908 =cut
 909
 910 sub GetManagedTagSubfields{
 911   my $dbh=C4::Context->dbh;
 912   my $rq=$dbh->prepare(qq|
 913 SELECT
 914   DISTINCT CONCAT( marc_subfield_structure.tagfield, tagsubfield ) AS tagsubfield,
 915   marc_subfield_structure.liblibrarian as subfielddesc,
 916   marc_tag_structure.liblibrarian as tagdesc
 917 FROM marc_subfield_structure
 918   LEFT JOIN marc_tag_structure
 919     ON marc_tag_structure.tagfield = marc_subfield_structure.tagfield
 920     AND marc_tag_structure.frameworkcode = marc_subfield_structure.frameworkcode
 921 WHERE marc_subfield_structure.tab>=0
 922 AND marc_tag_structure.tagfield NOT IN (SELECT tagfield FROM marc_subfield_structure WHERE kohafield like 'items.%')
 923 AND marc_tag_structure.tagfield NOT IN (SELECT tagfield FROM marc_subfield_structure WHERE kohafield = 'biblioitems.itemtype')
 924 AND marc_subfield_structure.kohafield <> 'biblio.biblionumber'
 925 AND marc_subfield_structure.kohafield <>  'biblioitems.biblioitemnumber'
 926 ORDER BY marc_subfield_structure.tagfield, tagsubfield|);
 927   $rq->execute;
 928   my $data=$rq->fetchall_arrayref({});
 929   return $data;
 930 }
 931
 932 1;
 933
 934 __END__
 935
 936 =head1 AUTHOR
 937
 938 Koha Team
 939
 940 =cut