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 $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 $query = qq|
 331         SELECT *
 332         FROM   itemtypes
 333     |;
 334     my $sth=$dbh->prepare($query);
 335     $sth->execute;
 336     while (my $IT=$sth->fetchrow_hashref) {
 337             $itemtypes{$IT->{'itemtype'}}=$IT;
 338     }
 339     return (\%itemtypes);
 340 }
 341
 342 # FIXME this function is better and should replace GetItemTypes everywhere
 343 sub get_itemtypeinfos_of {
 344     my @itemtypes = @_;
 345
 346     my $query = '
 347 SELECT itemtype,
 348        description,
 349        notforloan
 350   FROM itemtypes
 351   WHERE itemtype IN ('.join(',', map({"'".$_."'"} @itemtypes)).')
 352 ';
 353
 354     return get_infos_of($query, 'itemtype');
 355 }
 356
 357 =head2 getauthtypes
 358
 359   $authtypes = &getauthtypes();
 360
 361 Returns information about existing authtypes.
 362
 363 build a HTML select with the following code :
 364
 365 =head3 in PERL SCRIPT
 366
 367 my $authtypes = getauthtypes;
 368 my @authtypesloop;
 369 foreach my $thisauthtype (keys %$authtypes) {
 370     my $selected = 1 if $thisauthtype eq $authtype;
 371     my %row =(value => $thisauthtype,
 372                 selected => $selected,
 373                 authtypetext => $authtypes->{$thisauthtype}->{'authtypetext'},
 374             );
 375     push @authtypesloop, \%row;
 376 }
 377 $template->param(itemtypeloop => \@itemtypesloop);
 378
 379 =head3 in TEMPLATE
 380
 381 <form action='<!-- TMPL_VAR name="script_name" -->' method=post>
 382     <select name="authtype">
 383     <!-- TMPL_LOOP name="authtypeloop" -->
 384         <option value="<!-- TMPL_VAR name="value" -->" <!-- TMPL_IF name="selected" -->selected<!-- /TMPL_IF -->><!-- TMPL_VAR name="authtypetext" --></option>
 385     <!-- /TMPL_LOOP -->
 386     </select>
 387     <input type=text name=searchfield value="<!-- TMPL_VAR name="searchfield" -->">
 388     <input type="submit" value="OK" class="button">
 389 </form>
 390
 391
 392 =cut
 393
 394 sub getauthtypes {
 395 # returns a reference to a hash of references to authtypes...
 396     my %authtypes;
 397     my $dbh = C4::Context->dbh;
 398     my $sth=$dbh->prepare("select * from auth_types order by authtypetext");
 399     $sth->execute;
 400     while (my $IT=$sth->fetchrow_hashref) {
 401             $authtypes{$IT->{'authtypecode'}}=$IT;
 402     }
 403     return (\%authtypes);
 404 }
 405
 406 sub getauthtype {
 407     my ($authtypecode) = @_;
 408 # returns a reference to a hash of references to authtypes...
 409     my %authtypes;
 410     my $dbh = C4::Context->dbh;
 411     my $sth=$dbh->prepare("select * from auth_types where authtypecode=?");
 412     $sth->execute($authtypecode);
 413     my $res=$sth->fetchrow_hashref;
 414     return $res;
 415 }
 416
 417 =head2 getframework
 418
 419   $frameworks = &getframework();
 420
 421 Returns information about existing frameworks
 422
 423 build a HTML select with the following code :
 424
 425 =head3 in PERL SCRIPT
 426
 427 my $frameworks = frameworks();
 428 my @frameworkloop;
 429 foreach my $thisframework (keys %$frameworks) {
 430     my $selected = 1 if $thisframework eq $frameworkcode;
 431     my %row =(value => $thisframework,
 432                 selected => $selected,
 433                 description => $frameworks->{$thisframework}->{'frameworktext'},
 434             );
 435     push @frameworksloop, \%row;
 436 }
 437 $template->param(frameworkloop => \@frameworksloop);
 438
 439 =head3 in TEMPLATE
 440
 441 <form action='<!-- TMPL_VAR name="script_name" -->' method=post>
 442     <select name="frameworkcode">
 443         <option value="">Default</option>
 444     <!-- TMPL_LOOP name="frameworkloop" -->
 445         <option value="<!-- TMPL_VAR name="value" -->" <!-- TMPL_IF name="selected" -->selected<!-- /TMPL_IF -->><!-- TMPL_VAR name="frameworktext" --></option>
 446     <!-- /TMPL_LOOP -->
 447     </select>
 448     <input type=text name=searchfield value="<!-- TMPL_VAR name="searchfield" -->">
 449     <input type="submit" value="OK" class="button">
 450 </form>
 451
 452
 453 =cut
 454
 455 sub getframeworks {
 456 # returns a reference to a hash of references to branches...
 457     my %itemtypes;
 458     my $dbh = C4::Context->dbh;
 459     my $sth=$dbh->prepare("select * from biblio_framework");
 460     $sth->execute;
 461     while (my $IT=$sth->fetchrow_hashref) {
 462             $itemtypes{$IT->{'frameworkcode'}}=$IT;
 463     }
 464     return (\%itemtypes);
 465 }
 466 =head2 getframeworkinfo
 467
 468   $frameworkinfo = &getframeworkinfo($frameworkcode);
 469
 470 Returns information about an frameworkcode.
 471
 472 =cut
 473
 474 sub getframeworkinfo {
 475     my ($frameworkcode) = @_;
 476     my $dbh = C4::Context->dbh;
 477     my $sth=$dbh->prepare("select * from biblio_framework where frameworkcode=?");
 478     $sth->execute($frameworkcode);
 479     my $res = $sth->fetchrow_hashref;
 480     return $res;
 481 }
 482
 483
 484 =head2 getitemtypeinfo
 485
 486   $itemtype = &getitemtype($itemtype);
 487
 488 Returns information about an itemtype.
 489
 490 =cut
 491
 492 sub getitemtypeinfo {
 493     my ($itemtype) = @_;
 494     my $dbh = C4::Context->dbh;
 495     my $sth=$dbh->prepare("select * from itemtypes where itemtype=?");
 496     $sth->execute($itemtype);
 497     my $res = $sth->fetchrow_hashref;
 498
 499         $res->{imageurl} = getitemtypeimagesrcfromurl($res->{imageurl});
 500
 501     return $res;
 502 }
 503
 504 sub getitemtypeimagesrcfromurl {
 505     my ($imageurl) = @_;
 506
 507     if (defined $imageurl and $imageurl !~ m/^http/) {
 508         $imageurl =
 509             getitemtypeimagesrc()
 510             .'/'.$imageurl
 511             ;
 512     }
 513
 514     return $imageurl;
 515 }
 516
 517 sub getitemtypeimagedir {
 518     return
 519         C4::Context->intrahtdocs
 520         .'/'.C4::Context->preference('template')
 521         .'/itemtypeimg'
 522         ;
 523 }
 524
 525 sub getitemtypeimagesrc {
 526     return
 527         '/intranet-tmpl'
 528         .'/'.C4::Context->preference('template')
 529         .'/itemtypeimg'
 530         ;
 531 }
 532
 533 =head2 getprinters
 534
 535   $printers = &getprinters($env);
 536   @queues = keys %$printers;
 537
 538 Returns information about existing printer queues.
 539
 540 C<$env> is ignored.
 541
 542 C<$printers> is a reference-to-hash whose keys are the print queues
 543 defined in the printers table of the Koha database. The values are
 544 references-to-hash, whose keys are the fields in the printers table.
 545
 546 =cut
 547
 548 sub getprinters {
 549     my ($env) = @_;
 550     my %printers;
 551     my $dbh = C4::Context->dbh;
 552     my $sth=$dbh->prepare("select * from printers");
 553     $sth->execute;
 554     while (my $printer=$sth->fetchrow_hashref) {
 555     $printers{$printer->{'printqueue'}}=$printer;
 556     }
 557     return (\%printers);
 558 }
 559
 560 sub getbranch ($$) {
 561     my($query, $branches) = @_; # get branch for this query from branches
 562     my $branch = $query->param('branch');
 563     ($branch) || ($branch = $query->cookie('branch'));
 564     ($branches->{$branch}) || ($branch=(keys %$branches)[0]);
 565     return $branch;
 566 }
 567
 568 =item getbranchdetail
 569
 570   $branchname = &getbranchdetail($branchcode);
 571
 572 Given the branch code, the function returns the corresponding
 573 branch name for a comprehensive information display
 574
 575 =cut
 576
 577 sub getbranchdetail
 578 {
 579     my ($branchcode) = @_;
 580     my $dbh = C4::Context->dbh;
 581     my $sth = $dbh->prepare("SELECT * FROM branches WHERE branchcode = ?");
 582     $sth->execute($branchcode);
 583     my $branchname = $sth->fetchrow_hashref();
 584     $sth->finish();
 585     return $branchname;
 586 } # sub getbranchname
 587
 588
 589 sub getprinter ($$) {
 590     my($query, $printers) = @_; # get printer for this query from printers
 591     my $printer = $query->param('printer');
 592     ($printer) || ($printer = $query->cookie('printer')) || ($printer='');
 593     ($printers->{$printer}) || ($printer = (keys %$printers)[0]);
 594     return $printer;
 595 }
 596
 597 =item getalllanguages
 598
 599   (@languages) = &getalllanguages($type);
 600   (@languages) = &getalllanguages($type,$theme);
 601
 602 Returns an array of all available languages.
 603
 604 =cut
 605
 606 sub getalllanguages {
 607     my $type=shift;
 608     my $theme=shift;
 609     my $htdocs;
 610     my @languages;
 611     if ($type eq 'opac') {
 612         $htdocs=C4::Context->config('opachtdocs');
 613         if ($theme and -d "$htdocs/$theme") {
 614             opendir D, "$htdocs/$theme";
 615             foreach my $language (readdir D) {
 616                 next if $language=~/^\./;
 617                 next if $language eq 'all';
 618                 next if $language=~ /png$/;
 619                 next if $language=~ /css$/;
 620                 next if $language=~ /CVS$/;
 621                 next if $language=~ /itemtypeimg$/;
 622                 next if $language=~ /\.txt$/i; #Don't read the readme.txt !
 623                 push @languages, $language;
 624             }
 625             return sort @languages;
 626         } else {
 627             my $lang;
 628             foreach my $theme (getallthemes('opac')) {
 629                 opendir D, "$htdocs/$theme";
 630                 foreach my $language (readdir D) {
 631                     next if $language=~/^\./;
 632                     next if $language eq 'all';
 633                     next if $language=~ /png$/;
 634                     next if $language=~ /css$/;
 635                     next if $language=~ /CVS$/;
 636                     next if $language=~ /itemtypeimg$/;
 637                     next if $language=~ /\.txt$/i; #Don't read the readme.txt !
 638                     $lang->{$language}=1;
 639                 }
 640             }
 641             @languages=keys %$lang;
 642             return sort @languages;
 643         }
 644     } elsif ($type eq 'intranet') {
 645         $htdocs=C4::Context->config('intrahtdocs');
 646         if ($theme and -d "$htdocs/$theme") {
 647             opendir D, "$htdocs/$theme";
 648             foreach my $language (readdir D) {
 649                 next if $language=~/^\./;
 650                 next if $language eq 'all';
 651                 next if $language=~ /png$/;
 652                 next if $language=~ /css$/;
 653                 next if $language=~ /CVS$/;
 654                 next if $language=~ /itemtypeimg$/;
 655                 next if $language=~ /\.txt$/i; #Don't read the readme.txt !
 656                 push @languages, $language;
 657             }
 658             return sort @languages;
 659         } else {
 660             my $lang;
 661             foreach my $theme (getallthemes('opac')) {
 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                     next if $language=~ /\.txt$/i; #Don't read the readme.txt !
 671                     $lang->{$language}=1;
 672                 }
 673             }
 674             @languages=keys %$lang;
 675             return sort @languages;
 676         }
 677     } else {
 678         my $lang;
 679         my $htdocs=C4::Context->config('intrahtdocs');
 680         foreach my $theme (getallthemes('intranet')) {
 681             opendir D, "$htdocs/$theme";
 682             foreach my $language (readdir D) {
 683                 next if $language=~/^\./;
 684                 next if $language eq 'all';
 685                 next if $language=~ /png$/;
 686                 next if $language=~ /css$/;
 687                 next if $language=~ /CVS$/;
 688                 next if $language=~ /itemtypeimg$/;
 689                 next if $language=~ /\.txt$/i; #Don't read the readme.txt !
 690                 $lang->{$language}=1;
 691             }
 692         }
 693         $htdocs=C4::Context->config('opachtdocs');
 694         foreach my $theme (getallthemes('opac')) {
 695         opendir D, "$htdocs/$theme";
 696         foreach my $language (readdir D) {
 697             next if $language=~/^\./;
 698             next if $language eq 'all';
 699             next if $language=~ /png$/;
 700             next if $language=~ /css$/;
 701             next if $language=~ /CVS$/;
 702             next if $language=~ /itemtypeimg$/;
 703             next if $language=~ /\.txt$/i; #Don't read the readme.txt !
 704             $lang->{$language}=1;
 705             }
 706         }
 707         @languages=keys %$lang;
 708         return sort @languages;
 709     }
 710 }
 711
 712 =item getallthemes
 713
 714   (@themes) = &getallthemes('opac');
 715   (@themes) = &getallthemes('intranet');
 716
 717 Returns an array of all available themes.
 718
 719 =cut
 720
 721 sub getallthemes {
 722     my $type=shift;
 723     my $htdocs;
 724     my @themes;
 725     if ($type eq 'intranet') {
 726     $htdocs=C4::Context->config('intrahtdocs');
 727     } else {
 728     $htdocs=C4::Context->config('opachtdocs');
 729     }
 730     opendir D, "$htdocs";
 731     my @dirlist=readdir D;
 732     foreach my $directory (@dirlist) {
 733     -d "$htdocs/$directory/en" and push @themes, $directory;
 734     }
 735     return @themes;
 736 }
 737
 738 =item getnbpages
 739
 740 Returns the number of pages to display in a pagination bar, given the number
 741 of items and the number of items per page.
 742
 743 =cut
 744
 745 sub getnbpages {
 746     my ($nb_items, $nb_items_per_page) = @_;
 747
 748     return int(($nb_items - 1) / $nb_items_per_page) + 1;
 749 }
 750
 751
 752 =head2 getcities (OUEST-PROVENCE)
 753
 754   ($id_cityarrayref, $city_hashref) = &getcities();
 755
 756 Looks up the different city and zip in the database. Returns two
 757 elements: a reference-to-array, which lists the zip city
 758 codes, and a reference-to-hash, which maps the name of the city.
 759 WHERE =>OUEST PROVENCE OR EXTERIEUR
 760
 761 =cut
 762 sub getcities {
 763     #my ($type_city) = @_;
 764     my $dbh = C4::Context->dbh;
 765     my $sth=$dbh->prepare("Select cityid,city_name from cities order by cityid  ");
 766     #$sth->execute($type_city);
 767     $sth->execute();
 768     my %city;
 769     my @id;
 770 #    insert empty value to create a empty choice in cgi popup
 771
 772 while (my $data=$sth->fetchrow_hashref){
 773
 774     push @id,$data->{'cityid'};
 775       $city{$data->{'cityid'}}=$data->{'city_name'};
 776     }
 777
 778     #test to know if the table contain some records if no the function return nothing
 779     my $id=@id;
 780     $sth->finish;
 781     if ($id eq 0)
 782     {
 783     return();
 784     }
 785     else{
 786     unshift (@id ,"");
 787     return(\@id,\%city);
 788     }
 789 }
 790
 791
 792 =head2 getroadtypes (OUEST-PROVENCE)
 793
 794   ($idroadtypearrayref, $roadttype_hashref) = &getroadtypes();
 795
 796 Looks up the different road type . Returns two
 797 elements: a reference-to-array, which lists the id_roadtype
 798 codes, and a reference-to-hash, which maps the road type of the road .
 799
 800
 801 =cut
 802 sub getroadtypes {
 803     my $dbh = C4::Context->dbh;
 804     my $sth=$dbh->prepare("Select roadtypeid,road_type from roadtype order by road_type  ");
 805     $sth->execute();
 806     my %roadtype;
 807     my @id;
 808 #    insert empty value to create a empty choice in cgi popup
 809 while (my $data=$sth->fetchrow_hashref){
 810     push @id,$data->{'roadtypeid'};
 811       $roadtype{$data->{'roadtypeid'}}=$data->{'road_type'};
 812     }
 813     #test to know if the table contain some records if no the function return nothing
 814     my $id=@id;
 815     $sth->finish;
 816     if ($id eq 0)
 817     {
 818     return();
 819     }
 820     else{
 821         unshift (@id ,"");
 822         return(\@id,\%roadtype);
 823     }
 824 }
 825
 826 =head2 get_branchinfos_of
 827
 828   my $branchinfos_of = get_branchinfos_of(@branchcodes);
 829
 830 Associates a list of branchcodes to the information of the branch, taken in
 831 branches table.
 832
 833 Returns a href where keys are branchcodes and values are href where keys are
 834 branch information key.
 835
 836   print 'branchname is ', $branchinfos_of->{$code}->{branchname};
 837
 838 =cut
 839 sub get_branchinfos_of {
 840     my @branchcodes = @_;
 841
 842     my $query = '
 843 SELECT branchcode,
 844        branchname
 845   FROM branches
 846   WHERE branchcode IN ('.join(',', map({"'".$_."'"} @branchcodes)).')
 847 ';
 848     return get_infos_of($query, 'branchcode');
 849 }
 850
 851 =head2 get_notforloan_label_of
 852
 853   my $notforloan_label_of = get_notforloan_label_of();
 854
 855 Each authorised value of notforloan (information available in items and
 856 itemtypes) is link to a single label.
 857
 858 Returns a href where keys are authorised values and values are corresponding
 859 labels.
 860
 861   foreach my $authorised_value (keys %{$notforloan_label_of}) {
 862     printf(
 863         "authorised_value: %s => %s\n",
 864         $authorised_value,
 865         $notforloan_label_of->{$authorised_value}
 866     );
 867   }
 868
 869 =cut
 870 sub get_notforloan_label_of {
 871     my $dbh = C4::Context->dbh;
 872
 873     my $query = '
 874 SELECT authorised_value
 875   FROM marc_subfield_structure
 876   WHERE kohafield = \'items.notforloan\'
 877   LIMIT 0, 1
 878 ';
 879     my $sth = $dbh->prepare($query);
 880     $sth->execute();
 881     my ($statuscode) = $sth->fetchrow_array();
 882
 883     $query = '
 884 SELECT lib,
 885        authorised_value
 886   FROM authorised_values
 887   WHERE category = ?
 888 ';
 889     $sth = $dbh->prepare($query);
 890     $sth->execute($statuscode);
 891     my %notforloan_label_of;
 892     while (my $row = $sth->fetchrow_hashref) {
 893         $notforloan_label_of{ $row->{authorised_value} } = $row->{lib};
 894     }
 895     $sth->finish;
 896
 897     return \%notforloan_label_of;
 898 }
 899
 900 =head2 get_infos_of
 901
 902 Return a href where a key is associated to a href. You give a query, the
 903 name of the key among the fields returned by the query. If you also give as
 904 third argument the name of the value, the function returns a href of scalar.
 905
 906   my $query = '
 907 SELECT itemnumber,
 908        notforloan,
 909        barcode
 910   FROM items
 911 ';
 912
 913   # generic href of any information on the item, href of href.
 914   my $iteminfos_of = get_infos_of($query, 'itemnumber');
 915   print $iteminfos_of->{$itemnumber}{barcode};
 916
 917   # specific information, href of scalar
 918   my $barcode_of_item = get_infos_of($query, 'itemnumber', 'barcode');
 919   print $barcode_of_item->{$itemnumber};
 920
 921 =cut
 922 sub get_infos_of {
 923     my ($query, $key_name, $value_name) = @_;
 924
 925     my $dbh = C4::Context->dbh;
 926
 927     my $sth = $dbh->prepare($query);
 928     $sth->execute();
 929
 930     my %infos_of;
 931     while (my $row = $sth->fetchrow_hashref) {
 932         if (defined $value_name) {
 933             $infos_of{ $row->{$key_name} } = $row->{$value_name};
 934         }
 935         else {
 936             $infos_of{ $row->{$key_name} } = $row;
 937         }
 938     }
 939     $sth->finish;
 940
 941     return \%infos_of;
 942 }
 943
 944 1;
 945 __END__
 946
 947 =back
 948
 949 =head1 AUTHOR
 950
 951 Koha Team
 952
 953 =cut