C4/Koha.pm

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