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