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