koha-dev.rot13.org Git - koha_fer/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   $ethnicity = fixEthnicity('asian');
  39   ($categories, $labels) = borrowercategories();
  40   ($categories, $labels) = ethnicitycategories();
  41
  42 =head1 DESCRIPTION
  43
  44 Koha.pm provides many functions for Koha scripts.
  45
  46 =head1 FUNCTIONS
  47
  48 =over 2
  49
  50 =cut
  51
  52 @ISA = qw(Exporter);
  53 @EXPORT = qw(&slashifyDate
  54                         &fixEthnicity
  55                         &borrowercategories
  56                         &ethnicitycategories
  57                         &subfield_is_koha_internal_p
  58                         &getbranches &getbranch
  59                         &getprinters &getprinter
  60                         &getitemtypes &getitemtypeinfo
  61                         &getauthtypes
  62                         $DEBUG);
  63
  64 use vars qw();
  65
  66 my $DEBUG = 0;
  67
  68 =head2 slashifyDate
  69
  70   $slash_date = &slashifyDate($dash_date);
  71
  72 Takes a string of the form "DD-MM-YYYY" (or anything separated by
  73 dashes), converts it to the form "YYYY/MM/DD", and returns the result.
  74
  75 =cut
  76
  77 sub slashifyDate {
  78     # accepts a date of the form xx-xx-xx[xx] and returns it in the
  79     # form xx/xx/xx[xx]
  80     my @dateOut = split('-', shift);
  81     return("$dateOut[2]/$dateOut[1]/$dateOut[0]")
  82 }
  83
  84 =head2 fixEthnicity
  85
  86   $ethn_name = &fixEthnicity($ethn_code);
  87
  88 Takes an ethnicity code (e.g., "european" or "pi") and returns the
  89 corresponding descriptive name from the C<ethnicity> table in the
  90 Koha database ("European" or "Pacific Islander").
  91
  92 =cut
  93 #'
  94
  95 sub fixEthnicity($) {
  96
  97     my $ethnicity = shift;
  98     my $dbh = C4::Context->dbh;
  99     my $sth=$dbh->prepare("Select name from ethnicity where code = ?");
 100     $sth->execute($ethnicity);
 101     my $data=$sth->fetchrow_hashref;
 102     $sth->finish;
 103     return $data->{'name'};
 104 }
 105
 106 =head2 borrowercategories
 107
 108   ($codes_arrayref, $labels_hashref) = &borrowercategories();
 109
 110 Looks up the different types of borrowers in the database. Returns two
 111 elements: a reference-to-array, which lists the borrower category
 112 codes, and a reference-to-hash, which maps the borrower category codes
 113 to category descriptions.
 114
 115 =cut
 116 #'
 117
 118 sub borrowercategories {
 119     my $dbh = C4::Context->dbh;
 120     my $sth=$dbh->prepare("Select categorycode,description from categories order by description");
 121     $sth->execute;
 122     my %labels;
 123     my @codes;
 124     while (my $data=$sth->fetchrow_hashref){
 125       push @codes,$data->{'categorycode'};
 126       $labels{$data->{'categorycode'}}=$data->{'description'};
 127     }
 128     $sth->finish;
 129     return(\@codes,\%labels);
 130 }
 131
 132 =head2 ethnicitycategories
 133
 134   ($codes_arrayref, $labels_hashref) = &ethnicitycategories();
 135
 136 Looks up the different ethnic types in the database. Returns two
 137 elements: a reference-to-array, which lists the ethnicity codes, and a
 138 reference-to-hash, which maps the ethnicity codes to ethnicity
 139 descriptions.
 140
 141 =cut
 142 #'
 143
 144 sub ethnicitycategories {
 145     my $dbh = C4::Context->dbh;
 146     my $sth=$dbh->prepare("Select code,name from ethnicity order by name");
 147     $sth->execute;
 148     my %labels;
 149     my @codes;
 150     while (my $data=$sth->fetchrow_hashref){
 151       push @codes,$data->{'code'};
 152       $labels{$data->{'code'}}=$data->{'name'};
 153     }
 154     $sth->finish;
 155     return(\@codes,\%labels);
 156 }
 157
 158 # FIXME.. this should be moved to a MARC-specific module
 159 sub subfield_is_koha_internal_p ($) {
 160     my($subfield) = @_;
 161
 162     # We could match on 'lib' and 'tab' (and 'mandatory', & more to come!)
 163     # But real MARC subfields are always single-character
 164     # so it really is safer just to check the length
 165
 166     return length $subfield != 1;
 167 }
 168
 169 =head2 getbranches
 170
 171   $branches = &getbranches();
 172   returns informations about branches.
 173   Create a branch selector with the following code
 174
 175 =head3 in PERL SCRIPT
 176
 177 my $branches = getbranches;
 178 my @branchloop;
 179 foreach my $thisbranch (keys %$branches) {
 180         my $selected = 1 if $thisbranch eq $branch;
 181         my %row =(value => $thisbranch,
 182                                 selected => $selected,
 183                                 branchname => $branches->{$thisbranch}->{'branchname'},
 184                         );
 185         push @branchloop, \%row;
 186 }
 187
 188
 189 =head3 in TEMPLATE
 190                         <select name="branch">
 191                                 <option value="">Default</option>
 192                         <!-- TMPL_LOOP name="branchloop" -->
 193                                 <option value="<!-- TMPL_VAR name="value" -->" <!-- TMPL_IF name="selected" -->selected<!-- /TMPL_IF -->><!-- TMPL_VAR name="branchname" --></option>
 194                         <!-- /TMPL_LOOP -->
 195                         </select>
 196
 197 =cut
 198
 199 sub getbranches {
 200 # returns a reference to a hash of references to branches...
 201         my %branches;
 202         my $dbh = C4::Context->dbh;
 203         my $sth=$dbh->prepare("select * from branches order by branchname");
 204         $sth->execute;
 205         while (my $branch=$sth->fetchrow_hashref) {
 206                 my $nsth = $dbh->prepare("select categorycode from branchrelations where branchcode = ?");
 207                 $nsth->execute($branch->{'branchcode'});
 208                 while (my ($cat) = $nsth->fetchrow_array) {
 209                         # FIXME - This seems wrong. It ought to be
 210                         # $branch->{categorycodes}{$cat} = 1;
 211                         # otherwise, there's a namespace collision if there's a
 212                         # category with the same name as a field in the 'branches'
 213                         # table (i.e., don't create a category called "issuing").
 214                         # In addition, the current structure doesn't really allow
 215                         # you to list the categories that a branch belongs to:
 216                         # you'd have to list keys %$branch, and remove those keys
 217                         # that aren't fields in the "branches" table.
 218                         $branch->{$cat} = 1;
 219                         }
 220                         $branches{$branch->{'branchcode'}}=$branch;
 221         }
 222         return (\%branches);
 223 }
 224
 225 =head2 getitemtypes
 226
 227   $itemtypes = &getitemtypes();
 228
 229 Returns information about existing itemtypes.
 230
 231 build a HTML select with the following code :
 232
 233 =head3 in PERL SCRIPT
 234
 235 my $itemtypes = getitemtypes;
 236 my @itemtypesloop;
 237 foreach my $thisitemtype (keys %$itemtypes) {
 238         my $selected = 1 if $thisitemtype eq $itemtype;
 239         my %row =(value => $thisitemtype,
 240                                 selected => $selected,
 241                                 description => $itemtypes->{$thisitemtype}->{'description'},
 242                         );
 243         push @itemtypesloop, \%row;
 244 }
 245 $template->param(itemtypeloop => \@itemtypesloop);
 246
 247 =head3 in TEMPLATE
 248
 249 <form action='<!-- TMPL_VAR name="script_name" -->' method=post>
 250         <select name="itemtype">
 251                 <option value="">Default</option>
 252         <!-- TMPL_LOOP name="itemtypeloop" -->
 253                 <option value="<!-- TMPL_VAR name="value" -->" <!-- TMPL_IF name="selected" -->selected<!-- /TMPL_IF -->><!-- TMPL_VAR name="description" --></option>
 254         <!-- /TMPL_LOOP -->
 255         </select>
 256         <input type=text name=searchfield value="<!-- TMPL_VAR name="searchfield" -->">
 257         <input type="submit" value="OK" class="button">
 258 </form>
 259
 260
 261 =cut
 262
 263 sub getitemtypes {
 264 # returns a reference to a hash of references to branches...
 265         my %itemtypes;
 266         my $dbh = C4::Context->dbh;
 267         my $sth=$dbh->prepare("select * from itemtypes order by description");
 268         $sth->execute;
 269         while (my $IT=$sth->fetchrow_hashref) {
 270                         $itemtypes{$IT->{'itemtype'}}=$IT;
 271         }
 272         return (\%itemtypes);
 273 }
 274
 275 =head2 getauthtypes
 276
 277   $authtypes = &getauthtypes();
 278
 279 Returns information about existing authtypes.
 280
 281 build a HTML select with the following code :
 282
 283 =head3 in PERL SCRIPT
 284
 285 my $authtypes = getauthtypes;
 286 my @authtypesloop;
 287 foreach my $thisauthtype (keys %$authtypes) {
 288         my $selected = 1 if $thisauthtype eq $authtype;
 289         my %row =(value => $thisauthtype,
 290                                 selected => $selected,
 291                                 authtypetext => $authtypes->{$thisauthtype}->{'authtypetext'},
 292                         );
 293         push @authtypesloop, \%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="authtype">
 301         <!-- TMPL_LOOP name="authtypeloop" -->
 302                 <option value="<!-- TMPL_VAR name="value" -->" <!-- TMPL_IF name="selected" -->selected<!-- /TMPL_IF -->><!-- TMPL_VAR name="authtypetext" --></option>
 303         <!-- /TMPL_LOOP -->
 304         </select>
 305         <input type=text name=searchfield value="<!-- TMPL_VAR name="searchfield" -->">
 306         <input type="submit" value="OK" class="button">
 307 </form>
 308
 309
 310 =cut
 311
 312 sub getauthtypes {
 313 # returns a reference to a hash of references to authtypes...
 314         my %authtypes;
 315         my $dbh = C4::Context->dbh;
 316         my $sth=$dbh->prepare("select * from auth_types order by authtypetext");
 317         $sth->execute;
 318         while (my $IT=$sth->fetchrow_hashref) {
 319                         $authtypes{$IT->{'authtypecode'}}=$IT;
 320         }
 321         return (\%authtypes);
 322 }
 323
 324
 325 =head2 getitemtypeinfo
 326
 327   $itemtype = &getitemtype($itemtype);
 328
 329 Returns information about an itemtype.
 330
 331 =cut
 332
 333 sub getitemtypeinfo {
 334         my ($itemtype) = @_;
 335         my $dbh = C4::Context->dbh;
 336         my $sth=$dbh->prepare("select * from itemtypes where itemtype=?");
 337         $sth->execute($itemtype);
 338         my $res = $sth->fetchrow_hashref;
 339         return $res;
 340 }
 341
 342 =head2 getprinters
 343
 344   $printers = &getprinters($env);
 345   @queues = keys %$printers;
 346
 347 Returns information about existing printer queues.
 348
 349 C<$env> is ignored.
 350
 351 C<$printers> is a reference-to-hash whose keys are the print queues
 352 defined in the printers table of the Koha database. The values are
 353 references-to-hash, whose keys are the fields in the printers table.
 354
 355 =cut
 356
 357 sub getprinters {
 358     my ($env) = @_;
 359     my %printers;
 360     my $dbh = C4::Context->dbh;
 361     my $sth=$dbh->prepare("select * from printers");
 362     $sth->execute;
 363     while (my $printer=$sth->fetchrow_hashref) {
 364         $printers{$printer->{'printqueue'}}=$printer;
 365     }
 366     return (\%printers);
 367 }
 368 sub getbranch ($$) {
 369     my($query, $branches) = @_; # get branch for this query from branches
 370     my $branch = $query->param('branch');
 371     ($branch) || ($branch = $query->cookie('branch'));
 372     ($branches->{$branch}) || ($branch=(keys %$branches)[0]);
 373     return $branch;
 374 }
 375
 376 sub getprinter ($$) {
 377     my($query, $printers) = @_; # get printer for this query from printers
 378     my $printer = $query->param('printer');
 379     ($printer) || ($printer = $query->cookie('printer'));
 380     ($printers->{$printer}) || ($printer = (keys %$printers)[0]);
 381     return $printer;
 382 }
 383
 384
 385 1;
 386 __END__
 387
 388 =back
 389
 390 =head1 AUTHOR
 391
 392 Koha Team
 393
 394 =cut