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