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