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