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::Biblio;
  26 use vars qw($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             &subfield_is_koha_internal_p
  52             &GetBranches &getbranch &getbranchdetail
  53             &getprinters &getprinter
  54             &GetItemTypes &getitemtypeinfo &ItemType
  55                         get_itemtypeinfos_of
  56             &getframeworks &getframeworkinfo
  57             &getauthtypes &getauthtype
  58             &getallthemes &getalllanguages
  59             &getallbranches &getletters
  60             &getbranchname
  61                         getnbpages
  62                         getitemtypeimagedir
  63                         getitemtypeimagesrc
  64                         getitemtypeimagesrcfromurl
  65             &getcities
  66             &getroadtypes
  67                         get_branchinfos_of
  68                         get_notforloan_label_of
  69                         get_infos_of
  70             $DEBUG);
  71
  72 use vars qw();
  73
  74 my $DEBUG = 0;
  75
  76 # FIXME.. this should be moved to a MARC-specific module
  77 sub subfield_is_koha_internal_p ($) {
  78     my($subfield) = @_;
  79
  80     # We could match on 'lib' and 'tab' (and 'mandatory', & more to come!)
  81     # But real MARC subfields are always single-character
  82     # so it really is safer just to check the length
  83
  84     return length $subfield != 1;
  85 }
  86
  87 =head2 GetBranches
  88
  89   $branches = &GetBranches();
  90   returns informations about branches.
  91   Create a branch selector with the following code
  92   Is branchIndependant sensitive
  93    When IndependantBranches is set AND user is not superlibrarian, displays only user's branch
  94
  95 =head3 in PERL SCRIPT
  96
  97 my $branches = GetBranches;
  98 my @branchloop;
  99 foreach my $thisbranch (sort keys %$branches) {
 100     my $selected = 1 if $thisbranch eq $branch;
 101     my %row =(value => $thisbranch,
 102                 selected => $selected,
 103                 branchname => $branches->{$thisbranch}->{'branchname'},
 104             );
 105     push @branchloop, \%row;
 106 }
 107
 108
 109 =head3 in TEMPLATE
 110             <select name="branch">
 111                 <option value="">Default</option>
 112             <!-- TMPL_LOOP name="branchloop" -->
 113                 <option value="<!-- TMPL_VAR name="value" -->" <!-- TMPL_IF name="selected" -->selected<!-- /TMPL_IF -->><!-- TMPL_VAR name="branchname" --></option>
 114             <!-- /TMPL_LOOP -->
 115             </select>
 116
 117 =cut
 118
 119 sub GetBranches {
 120 # returns a reference to a hash of references to branches...
 121     my ($type) = @_;
 122     my %branches;
 123     my $branch;
 124     my $dbh = C4::Context->dbh;
 125     my $sth;
 126     if (C4::Context->preference("IndependantBranches") && (C4::Context->userenv->{flags}!=1)){
 127         my $strsth ="Select * from branches ";
 128         $strsth.= " WHERE branchcode = ".$dbh->quote(C4::Context->userenv->{branch});
 129         $strsth.= " order by branchname";
 130         $sth=$dbh->prepare($strsth);
 131     } else {
 132         $sth = $dbh->prepare("Select * from branches order by branchname");
 133     }
 134     $sth->execute;
 135     while ($branch=$sth->fetchrow_hashref) {
 136         my $nsth = $dbh->prepare("select categorycode from branchrelations where branchcode = ?");
 137             if ($type){
 138             $nsth = $dbh->prepare("select categorycode from branchrelations where branchcode = ? and categorycode = ?");
 139             $nsth->execute($branch->{'branchcode'},$type);
 140           } else {
 141             $nsth->execute($branch->{'branchcode'});
 142           }
 143         while (my ($cat) = $nsth->fetchrow_array) {
 144             # FIXME - This seems wrong. It ought to be
 145             # $branch->{categorycodes}{$cat} = 1;
 146             # otherwise, there's a namespace collision if there's a
 147             # category with the same name as a field in the 'branches'
 148             # table (i.e., don't create a category called "issuing").
 149             # In addition, the current structure doesn't really allow
 150             # you to list the categories that a branch belongs to:
 151             # you'd have to list keys %$branch, and remove those keys
 152             # that aren't fields in the "branches" table.
 153             $branch->{$cat} = 1;
 154             }
 155 }
 156     return (\%branches);
 157 }
 158
 159 sub getbranchname {
 160     my ($branchcode)=@_;
 161     my $dbh = C4::Context->dbh;
 162     my $sth;
 163        $sth = $dbh->prepare("Select branchname from branches where branchcode=?");
 164     $sth->execute($branchcode);
 165     my $branchname = $sth->fetchrow_array;
 166     $sth->finish;
 167
 168     return($branchname);
 169 }
 170
 171 =head2 getallbranches
 172
 173   $branches = &getallbranches();
 174   returns informations about ALL branches.
 175   Create a branch selector with the following code
 176   IndependantBranches Insensitive...
 177
 178 =head3 in PERL SCRIPT
 179
 180 my $branches = getallbranches;
 181 my @branchloop;
 182 foreach my $thisbranch (keys %$branches) {
 183     my $selected = 1 if $thisbranch eq $branch;
 184     my %row =(value => $thisbranch,
 185                 selected => $selected,
 186                 branchname => $branches->{$thisbranch}->{'branchname'},
 187             );
 188     push @branchloop, \%row;
 189 }
 190
 191
 192 =head3 in TEMPLATE
 193             <select name="branch">
 194                 <option value="">Default</option>
 195             <!-- TMPL_LOOP name="branchloop" -->
 196                 <option value="<!-- TMPL_VAR name="value" -->" <!-- TMPL_IF name="selected" -->selected<!-- /TMPL_IF -->><!-- TMPL_VAR name="branchname" --></option>
 197             <!-- /TMPL_LOOP -->
 198             </select>
 199
 200 =cut
 201
 202
 203 sub getallbranches {
 204 # returns a reference to a hash of references to ALL branches...
 205     my %branches;
 206     my $dbh = C4::Context->dbh;
 207     my $sth;
 208        $sth = $dbh->prepare("Select * from branches order by branchname");
 209     $sth->execute;
 210     while (my $branch=$sth->fetchrow_hashref) {
 211         my $nsth = $dbh->prepare("select categorycode from branchrelations where branchcode = ?");
 212         $nsth->execute($branch->{'branchcode'});
 213         while (my ($cat) = $nsth->fetchrow_array) {
 214             # FIXME - This seems wrong. It ought to be
 215             # $branch->{categorycodes}{$cat} = 1;
 216             # otherwise, there's a namespace collision if there's a
 217             # category with the same name as a field in the 'branches'
 218             # table (i.e., don't create a category called "issuing").
 219             # In addition, the current structure doesn't really allow
 220             # you to list the categories that a branch belongs to:
 221             # you'd have to list keys %$branch, and remove those keys
 222             # that aren't fields in the "branches" table.
 223             $branch->{$cat} = 1;
 224             }
 225             $branches{$branch->{'branchcode'}}=$branch;
 226     }
 227     return (\%branches);
 228 }
 229
 230 =head2 getletters
 231
 232   $letters = &getletters($category);
 233   returns informations about letters.
 234   if needed, $category filters for letters given category
 235   Create a letter selector with the following code
 236
 237 =head3 in PERL SCRIPT
 238
 239 my $letters = getletters($cat);
 240 my @letterloop;
 241 foreach my $thisletter (keys %$letters) {
 242     my $selected = 1 if $thisletter eq $letter;
 243     my %row =(value => $thisletter,
 244                 selected => $selected,
 245                 lettername => $letters->{$thisletter},
 246             );
 247     push @letterloop, \%row;
 248 }
 249
 250
 251 =head3 in TEMPLATE
 252             <select name="letter">
 253                 <option value="">Default</option>
 254             <!-- TMPL_LOOP name="letterloop" -->
 255                 <option value="<!-- TMPL_VAR name="value" -->" <!-- TMPL_IF name="selected" -->selected<!-- /TMPL_IF -->><!-- TMPL_VAR name="lettername" --></option>
 256             <!-- /TMPL_LOOP -->
 257             </select>
 258
 259 =cut
 260
 261 sub getletters {
 262 # returns a reference to a hash of references to ALL letters...
 263     my $cat =@_;
 264     my %letters;
 265     my $dbh = C4::Context->dbh;
 266     my $sth;
 267        if ($cat ne ""){
 268         $sth = $dbh->prepare("Select * from letter where module = \'".$cat."\' order by name");
 269     } else {
 270         $sth = $dbh->prepare("Select * from letter order by name");
 271     }
 272     $sth->execute;
 273     my $count;
 274     while (my $letter=$sth->fetchrow_hashref) {
 275             $letters{$letter->{'code'}}=$letter->{'name'};
 276             $count++;
 277     }
 278     return ($count,\%letters);
 279 }
 280
 281 =head2 GetItemTypes
 282
 283   $itemtypes = &GetItemTypes();
 284
 285 Returns information about existing itemtypes.
 286
 287 build a HTML select with the following code :
 288
 289 =head3 in PERL SCRIPT
 290
 291 my $itemtypes = GetItemTypes;
 292 my @itemtypesloop;
 293 foreach my $thisitemtype (sort keys %$itemtypes) {
 294     my $selected = 1 if $thisitemtype eq $itemtype;
 295     my %row =(value => $thisitemtype,
 296                 selected => $selected,
 297                 description => $itemtypes->{$thisitemtype}->{'description'},
 298             );
 299     push @itemtypesloop, \%row;
 300 }
 301 $template->param(itemtypeloop => \@itemtypesloop);
 302
 303 =head3 in TEMPLATE
 304
 305 <form action='<!-- TMPL_VAR name="script_name" -->' method=post>
 306     <select name="itemtype">
 307         <option value="">Default</option>
 308     <!-- TMPL_LOOP name="itemtypeloop" -->
 309         <option value="<!-- TMPL_VAR name="value" -->" <!-- TMPL_IF name="selected" -->selected<!-- /TMPL_IF -->><!-- TMPL_VAR name="description" --></option>
 310     <!-- /TMPL_LOOP -->
 311     </select>
 312     <input type=text name=searchfield value="<!-- TMPL_VAR name="searchfield" -->">
 313     <input type="submit" value="OK" class="button">
 314 </form>
 315
 316
 317 =cut
 318
 319 sub GetItemTypes {
 320 # returns a reference to a hash of references to branches...
 321     my %itemtypes;
 322     my $dbh = C4::Context->dbh;
 323     my $query = qq|
 324         SELECT *
 325         FROM   itemtypes
 326     |;
 327     my $sth=$dbh->prepare($query);
 328     $sth->execute;
 329     while (my $IT=$sth->fetchrow_hashref) {
 330             $itemtypes{$IT->{'itemtype'}}=$IT;
 331     }
 332     return (\%itemtypes);
 333 }
 334
 335 # FIXME this function is better and should replace GetItemTypes everywhere
 336 sub get_itemtypeinfos_of {
 337     my @itemtypes = @_;
 338
 339     my $query = '
 340 SELECT itemtype,
 341        description,
 342        notforloan
 343   FROM itemtypes
 344   WHERE itemtype IN ('.join(',', map({"'".$_."'"} @itemtypes)).')
 345 ';
 346
 347     return get_infos_of($query, 'itemtype');
 348 }
 349
 350 sub ItemType {
 351   my ($type)=@_;
 352   my $dbh = C4::Context->dbh;
 353   my $sth=$dbh->prepare("select description from itemtypes where itemtype=?");
 354   $sth->execute($type);
 355   my $dat=$sth->fetchrow_hashref;
 356   $sth->finish;
 357   return ($dat->{'description'});
 358 }
 359 =head2 getauthtypes
 360
 361   $authtypes = &getauthtypes();
 362
 363 Returns information about existing authtypes.
 364
 365 build a HTML select with the following code :
 366
 367 =head3 in PERL SCRIPT
 368
 369 my $authtypes = getauthtypes;
 370 my @authtypesloop;
 371 foreach my $thisauthtype (keys %$authtypes) {
 372     my $selected = 1 if $thisauthtype eq $authtype;
 373     my %row =(value => $thisauthtype,
 374                 selected => $selected,
 375                 authtypetext => $authtypes->{$thisauthtype}->{'authtypetext'},
 376             );
 377     push @authtypesloop, \%row;
 378 }
 379 $template->param(itemtypeloop => \@itemtypesloop);
 380
 381 =head3 in TEMPLATE
 382
 383 <form action='<!-- TMPL_VAR name="script_name" -->' method=post>
 384     <select name="authtype">
 385     <!-- TMPL_LOOP name="authtypeloop" -->
 386         <option value="<!-- TMPL_VAR name="value" -->" <!-- TMPL_IF name="selected" -->selected<!-- /TMPL_IF -->><!-- TMPL_VAR name="authtypetext" --></option>
 387     <!-- /TMPL_LOOP -->
 388     </select>
 389     <input type=text name=searchfield value="<!-- TMPL_VAR name="searchfield" -->">
 390     <input type="submit" value="OK" class="button">
 391 </form>
 392
 393
 394 =cut
 395
 396 sub getauthtypes {
 397 # returns a reference to a hash of references to authtypes...
 398     my %authtypes;
 399     my $dbh = C4::Context->dbh;
 400     my $sth=$dbh->prepare("select * from auth_types order by authtypetext");
 401     $sth->execute;
 402     while (my $IT=$sth->fetchrow_hashref) {
 403             $authtypes{$IT->{'authtypecode'}}=$IT;
 404     }
 405     return (\%authtypes);
 406 }
 407
 408 sub getauthtype {
 409     my ($authtypecode) = @_;
 410 # returns a reference to a hash of references to authtypes...
 411     my %authtypes;
 412     my $dbh = C4::Context->dbh;
 413     my $sth=$dbh->prepare("select * from auth_types where authtypecode=?");
 414     $sth->execute($authtypecode);
 415     my $res=$sth->fetchrow_hashref;
 416     return $res;
 417 }
 418
 419 =head2 getframework
 420
 421   $frameworks = &getframework();
 422
 423 Returns information about existing frameworks
 424
 425 build a HTML select with the following code :
 426
 427 =head3 in PERL SCRIPT
 428
 429 my $frameworks = frameworks();
 430 my @frameworkloop;
 431 foreach my $thisframework (keys %$frameworks) {
 432     my $selected = 1 if $thisframework eq $frameworkcode;
 433     my %row =(value => $thisframework,
 434                 selected => $selected,
 435                 description => $frameworks->{$thisframework}->{'frameworktext'},
 436             );
 437     push @frameworksloop, \%row;
 438 }
 439 $template->param(frameworkloop => \@frameworksloop);
 440
 441 =head3 in TEMPLATE
 442
 443 <form action='<!-- TMPL_VAR name="script_name" -->' method=post>
 444     <select name="frameworkcode">
 445         <option value="">Default</option>
 446     <!-- TMPL_LOOP name="frameworkloop" -->
 447         <option value="<!-- TMPL_VAR name="value" -->" <!-- TMPL_IF name="selected" -->selected<!-- /TMPL_IF -->><!-- TMPL_VAR name="frameworktext" --></option>
 448     <!-- /TMPL_LOOP -->
 449     </select>
 450     <input type=text name=searchfield value="<!-- TMPL_VAR name="searchfield" -->">
 451     <input type="submit" value="OK" class="button">
 452 </form>
 453
 454
 455 =cut
 456
 457 sub getframeworks {
 458 # returns a reference to a hash of references to branches...
 459     my %itemtypes;
 460     my $dbh = C4::Context->dbh;
 461     my $sth=$dbh->prepare("select * from biblios_framework");
 462     $sth->execute;
 463     while (my $IT=$sth->fetchrow_hashref) {
 464             $itemtypes{$IT->{'frameworkcode'}}=$IT;
 465     }
 466     return (\%itemtypes);
 467 }
 468 =head2 getframeworkinfo
 469
 470   $frameworkinfo = &getframeworkinfo($frameworkcode);
 471
 472 Returns information about an frameworkcode.
 473
 474 =cut
 475
 476 sub getframeworkinfo {
 477     my ($frameworkcode) = @_;
 478     my $dbh = C4::Context->dbh;
 479     my $sth=$dbh->prepare("select * from biblios_framework where frameworkcode=?");
 480     $sth->execute($frameworkcode);
 481     my $res = $sth->fetchrow_hashref;
 482     return $res;
 483 }
 484
 485
 486 =head2 getitemtypeinfo
 487
 488   $itemtype = &getitemtype($itemtype);
 489
 490 Returns information about an itemtype.
 491
 492 =cut
 493
 494 sub getitemtypeinfo {
 495     my ($itemtype) = @_;
 496     my $dbh = C4::Context->dbh;
 497     my $sth=$dbh->prepare("select * from itemtypes where itemtype=?");
 498     $sth->execute($itemtype);
 499     my $res = $sth->fetchrow_hashref;
 500
 501         $res->{imageurl} = getitemtypeimagesrcfromurl($res->{imageurl});
 502
 503     return $res;
 504 }
 505
 506 sub getitemtypeimagesrcfromurl {
 507     my ($imageurl) = @_;
 508
 509     if (defined $imageurl and $imageurl !~ m/^http/) {
 510         $imageurl =
 511             getitemtypeimagesrc()
 512             .'/'.$imageurl
 513             ;
 514     }
 515
 516     return $imageurl;
 517 }
 518
 519 sub getitemtypeimagedir {
 520     return
 521         C4::Context->intrahtdocs
 522         .'/'.C4::Context->preference('template')
 523         .'/itemtypeimg'
 524         ;
 525 }
 526
 527 sub getitemtypeimagesrc {
 528     return
 529         '/intranet-tmpl'
 530         .'/'.C4::Context->preference('template')
 531         .'/itemtypeimg'
 532         ;
 533 }
 534
 535 =head2 getprinters
 536
 537   $printers = &getprinters($env);
 538   @queues = keys %$printers;
 539
 540 Returns information about existing printer queues.
 541
 542 C<$env> is ignored.
 543
 544 C<$printers> is a reference-to-hash whose keys are the print queues
 545 defined in the printers table of the Koha database. The values are
 546 references-to-hash, whose keys are the fields in the printers table.
 547
 548 =cut
 549
 550 sub getprinters {
 551     my ($env) = @_;
 552     my %printers;
 553     my $dbh = C4::Context->dbh;
 554     my $sth=$dbh->prepare("select * from printers");
 555     $sth->execute;
 556     while (my $printer=$sth->fetchrow_hashref) {
 557     $printers{$printer->{'printqueue'}}=$printer;
 558     }
 559     return (\%printers);
 560 }
 561
 562 sub getbranch ($$) {
 563     my($query, $branches) = @_; # get branch for this query from branches
 564     my $branch = $query->param('branch');
 565     ($branch) || ($branch = $query->cookie('branch'));
 566     ($branches->{$branch}) || ($branch=(keys %$branches)[0]);
 567     return $branch;
 568 }
 569
 570 =item getbranchdetail
 571
 572   $branchname = &getbranchdetail($branchcode);
 573
 574 Given the branch code, the function returns the corresponding
 575 branch name for a comprehensive information display
 576
 577 =cut
 578
 579 sub getbranchdetail
 580 {
 581     my ($branchcode) = @_;
 582     my $dbh = C4::Context->dbh;
 583     my $sth = $dbh->prepare("SELECT * FROM branches WHERE branchcode = ?");
 584     $sth->execute($branchcode);
 585     my $branchname = $sth->fetchrow_hashref();
 586     $sth->finish();
 587     return $branchname;
 588 } # sub getbranchname
 589
 590
 591 sub getprinter ($$) {
 592     my($query, $printers) = @_; # get printer for this query from printers
 593     my $printer = $query->param('printer');
 594     ($printer) || ($printer = $query->cookie('printer')) || ($printer='');
 595     ($printers->{$printer}) || ($printer = (keys %$printers)[0]);
 596     return $printer;
 597 }
 598
 599 =item getalllanguages
 600
 601   (@languages) = &getalllanguages($type);
 602   (@languages) = &getalllanguages($type,$theme);
 603
 604 Returns an array of all available languages.
 605
 606 =cut
 607
 608 sub getalllanguages {
 609     my $type=shift;
 610     my $theme=shift;
 611     my $htdocs;
 612     my @languages;
 613     if ($type eq 'opac') {
 614         $htdocs=C4::Context->config('opachtdocs');
 615         if ($theme and -d "$htdocs/$theme") {
 616             opendir D, "$htdocs/$theme";
 617             foreach my $language (readdir D) {
 618                 next if $language=~/^\./;
 619                 next if $language eq 'all';
 620                 next if $language=~ /png$/;
 621                 next if $language=~ /css$/;
 622                 next if $language=~ /CVS$/;
 623                 next if $language=~ /itemtypeimg$/;
 624                 next if $language=~ /\.txt$/i; #Don't read the readme.txt !
 625                 push @languages, $language;
 626             }
 627             return sort @languages;
 628         } else {
 629             my $lang;
 630             foreach my $theme (getallthemes('opac')) {
 631                 opendir D, "$htdocs/$theme";
 632                 foreach my $language (readdir D) {
 633                     next if $language=~/^\./;
 634                     next if $language eq 'all';
 635                     next if $language=~ /png$/;
 636                     next if $language=~ /css$/;
 637                     next if $language=~ /CVS$/;
 638                     next if $language=~ /itemtypeimg$/;
 639                     next if $language=~ /\.txt$/i; #Don't read the readme.txt !
 640                     $lang->{$language}=1;
 641                 }
 642             }
 643             @languages=keys %$lang;
 644             return sort @languages;
 645         }
 646     } elsif ($type eq 'intranet') {
 647         $htdocs=C4::Context->config('intrahtdocs');
 648         if ($theme and -d "$htdocs/$theme") {
 649             opendir D, "$htdocs/$theme";
 650             foreach my $language (readdir D) {
 651                 next if $language=~/^\./;
 652                 next if $language eq 'all';
 653                 next if $language=~ /png$/;
 654                 next if $language=~ /css$/;
 655                 next if $language=~ /CVS$/;
 656                 next if $language=~ /itemtypeimg$/;
 657                 next if $language=~ /\.txt$/i; #Don't read the readme.txt !
 658                 push @languages, $language;
 659             }
 660             return sort @languages;
 661         } else {
 662             my $lang;
 663             foreach my $theme (getallthemes('opac')) {
 664                 opendir D, "$htdocs/$theme";
 665                 foreach my $language (readdir D) {
 666                     next if $language=~/^\./;
 667                     next if $language eq 'all';
 668                     next if $language=~ /png$/;
 669                     next if $language=~ /css$/;
 670                     next if $language=~ /CVS$/;
 671                     next if $language=~ /itemtypeimg$/;
 672                     next if $language=~ /\.txt$/i; #Don't read the readme.txt !
 673                     $lang->{$language}=1;
 674                 }
 675             }
 676             @languages=keys %$lang;
 677             return sort @languages;
 678         }
 679     } else {
 680         my $lang;
 681         my $htdocs=C4::Context->config('intrahtdocs');
 682         foreach my $theme (getallthemes('intranet')) {
 683             opendir D, "$htdocs/$theme";
 684             foreach my $language (readdir D) {
 685                 next if $language=~/^\./;
 686                 next if $language eq 'all';
 687                 next if $language=~ /png$/;
 688                 next if $language=~ /css$/;
 689                 next if $language=~ /CVS$/;
 690                 next if $language=~ /itemtypeimg$/;
 691                 next if $language=~ /\.txt$/i; #Don't read the readme.txt !
 692                 $lang->{$language}=1;
 693             }
 694         }
 695         $htdocs=C4::Context->config('opachtdocs');
 696         foreach my $theme (getallthemes('opac')) {
 697         opendir D, "$htdocs/$theme";
 698         foreach my $language (readdir D) {
 699             next if $language=~/^\./;
 700             next if $language eq 'all';
 701             next if $language=~ /png$/;
 702             next if $language=~ /css$/;
 703             next if $language=~ /CVS$/;
 704             next if $language=~ /itemtypeimg$/;
 705             next if $language=~ /\.txt$/i; #Don't read the readme.txt !
 706             $lang->{$language}=1;
 707             }
 708         }
 709         @languages=keys %$lang;
 710         return sort @languages;
 711     }
 712 }
 713
 714 =item getallthemes
 715
 716   (@themes) = &getallthemes('opac');
 717   (@themes) = &getallthemes('intranet');
 718
 719 Returns an array of all available themes.
 720
 721 =cut
 722
 723 sub getallthemes {
 724     my $type=shift;
 725     my $htdocs;
 726     my @themes;
 727     if ($type eq 'intranet') {
 728     $htdocs=C4::Context->config('intrahtdocs');
 729     } else {
 730     $htdocs=C4::Context->config('opachtdocs');
 731     }
 732     opendir D, "$htdocs";
 733     my @dirlist=readdir D;
 734     foreach my $directory (@dirlist) {
 735     -d "$htdocs/$directory/en" and push @themes, $directory;
 736     }
 737     return @themes;
 738 }
 739
 740 =item getnbpages
 741
 742 Returns the number of pages to display in a pagination bar, given the number
 743 of items and the number of items per page.
 744
 745 =cut
 746
 747 sub getnbpages {
 748     my ($nb_items, $nb_items_per_page) = @_;
 749
 750     return int(($nb_items - 1) / $nb_items_per_page) + 1;
 751 }
 752
 753
 754 =head2 getcities (OUEST-PROVENCE)
 755
 756   ($id_cityarrayref, $city_hashref) = &getcities();
 757
 758 Looks up the different city and zip in the database. Returns two
 759 elements: a reference-to-array, which lists the zip city
 760 codes, and a reference-to-hash, which maps the name of the city.
 761 WHERE =>OUEST PROVENCE OR EXTERIEUR
 762
 763 =cut
 764 sub getcities {
 765     #my ($type_city) = @_;
 766     my $dbh = C4::Context->dbh;
 767     my $sth=$dbh->prepare("Select cityid,city_name from cities order by cityid  ");
 768     #$sth->execute($type_city);
 769     $sth->execute();
 770     my %city;
 771     my @id;
 772 #    insert empty value to create a empty choice in cgi popup
 773
 774 while (my $data=$sth->fetchrow_hashref){
 775
 776     push @id,$data->{'cityid'};
 777       $city{$data->{'cityid'}}=$data->{'city_name'};
 778     }
 779
 780     #test to know if the table contain some records if no the function return nothing
 781     my $id=@id;
 782     $sth->finish;
 783     if ($id eq 0)
 784     {
 785     return();
 786     }
 787     else{
 788     unshift (@id ,"");
 789     return(\@id,\%city);
 790     }
 791 }
 792
 793
 794 =head2 getroadtypes (OUEST-PROVENCE)
 795
 796   ($idroadtypearrayref, $roadttype_hashref) = &getroadtypes();
 797
 798 Looks up the different road type . Returns two
 799 elements: a reference-to-array, which lists the id_roadtype
 800 codes, and a reference-to-hash, which maps the road type of the road .
 801
 802
 803 =cut
 804 sub getroadtypes {
 805     my $dbh = C4::Context->dbh;
 806     my $sth=$dbh->prepare("Select roadtypeid,road_type from roadtype order by road_type  ");
 807     $sth->execute();
 808     my %roadtype;
 809     my @id;
 810 #    insert empty value to create a empty choice in cgi popup
 811 while (my $data=$sth->fetchrow_hashref){
 812     push @id,$data->{'roadtypeid'};
 813       $roadtype{$data->{'roadtypeid'}}=$data->{'road_type'};
 814     }
 815     #test to know if the table contain some records if no the function return nothing
 816     my $id=@id;
 817     $sth->finish;
 818     if ($id eq 0)
 819     {
 820     return();
 821     }
 822     else{
 823         unshift (@id ,"");
 824         return(\@id,\%roadtype);
 825     }
 826 }
 827
 828 =head2 get_branchinfos_of
 829
 830   my $branchinfos_of = get_branchinfos_of(@branchcodes);
 831
 832 Associates a list of branchcodes to the information of the branch, taken in
 833 branches table.
 834
 835 Returns a href where keys are branchcodes and values are href where keys are
 836 branch information key.
 837
 838   print 'branchname is ', $branchinfos_of->{$code}->{branchname};
 839
 840 =cut
 841 sub get_branchinfos_of {
 842     my @branchcodes = @_;
 843
 844     my $query = '
 845 SELECT branchcode,
 846        branchname
 847   FROM branches
 848   WHERE branchcode IN ('.join(',', map({"'".$_."'"} @branchcodes)).')
 849 ';
 850     return get_infos_of($query, 'branchcode');
 851 }
 852
 853 =head2 get_notforloan_label_of
 854
 855   my $notforloan_label_of = get_notforloan_label_of();
 856
 857 Each authorised value of notforloan (information available in items and
 858 itemtypes) is link to a single label.
 859
 860 Returns a href where keys are authorised values and values are corresponding
 861 labels.
 862
 863   foreach my $authorised_value (keys %{$notforloan_label_of}) {
 864     printf(
 865         "authorised_value: %s => %s\n",
 866         $authorised_value,
 867         $notforloan_label_of->{$authorised_value}
 868     );
 869   }
 870
 871 =cut
 872 sub get_notforloan_label_of {
 873     my $dbh = C4::Context->dbh;
 874 my($tagfield,$tagsubfield)=MARCfind_marc_from_kohafield("notforloan","holdings");
 875     my $query = '
 876 SELECT authorised_value
 877   FROM holdings_subfield_structure
 878   WHERE tagfield =$tagfield and tagsubfield=$tagsubfield
 879   LIMIT 0, 1
 880 ';
 881     my $sth = $dbh->prepare($query);
 882     $sth->execute();
 883     my ($statuscode) = $sth->fetchrow_array();
 884
 885     $query = '
 886 SELECT lib,
 887        authorised_value
 888   FROM authorised_values
 889   WHERE category = ?
 890 ';
 891     $sth = $dbh->prepare($query);
 892     $sth->execute($statuscode);
 893     my %notforloan_label_of;
 894     while (my $row = $sth->fetchrow_hashref) {
 895         $notforloan_label_of{ $row->{authorised_value} } = $row->{lib};
 896     }
 897     $sth->finish;
 898
 899     return \%notforloan_label_of;
 900 }
 901
 902 =head2 get_infos_of
 903
 904 Return a href where a key is associated to a href. You give a query, the
 905 name of the key among the fields returned by the query. If you also give as
 906 third argument the name of the value, the function returns a href of scalar.
 907
 908   my $query = '
 909 SELECT itemnumber,
 910        notforloan,
 911        barcode
 912   FROM items
 913 ';
 914
 915   # generic href of any information on the item, href of href.
 916   my $iteminfos_of = get_infos_of($query, 'itemnumber');
 917   print $iteminfos_of->{$itemnumber}{barcode};
 918
 919   # specific information, href of scalar
 920   my $barcode_of_item = get_infos_of($query, 'itemnumber', 'barcode');
 921   print $barcode_of_item->{$itemnumber};
 922
 923 =cut
 924 sub get_infos_of {
 925     my ($query, $key_name, $value_name) = @_;
 926
 927     my $dbh = C4::Context->dbh;
 928
 929     my $sth = $dbh->prepare($query);
 930     $sth->execute();
 931
 932     my %infos_of;
 933     while (my $row = $sth->fetchrow_hashref) {
 934         if (defined $value_name) {
 935             $infos_of{ $row->{$key_name} } = $row->{$value_name};
 936         }
 937         else {
 938             $infos_of{ $row->{$key_name} } = $row;
 939         }
 940     }
 941     $sth->finish;
 942
 943     return \%infos_of;
 944 }
 945
 946 1;
 947 __END__
 948
 949 =back
 950
 951 =head1 AUTHOR
 952
 953 Koha Team
 954
 955 =cut