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