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