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                         $DEBUG);
  62
  63 use vars qw();
  64
  65 my $DEBUG = 0;
  66
  67 =head2 slashifyDate
  68
  69   $slash_date = &slashifyDate($dash_date);
  70
  71 Takes a string of the form "DD-MM-YYYY" (or anything separated by
  72 dashes), converts it to the form "YYYY/MM/DD", and returns the result.
  73
  74 =cut
  75
  76 sub slashifyDate {
  77     # accepts a date of the form xx-xx-xx[xx] and returns it in the
  78     # form xx/xx/xx[xx]
  79     my @dateOut = split('-', shift);
  80     return("$dateOut[2]/$dateOut[1]/$dateOut[0]")
  81 }
  82
  83 =head2 fixEthnicity
  84
  85   $ethn_name = &fixEthnicity($ethn_code);
  86
  87 Takes an ethnicity code (e.g., "european" or "pi") and returns the
  88 corresponding descriptive name from the C<ethnicity> table in the
  89 Koha database ("European" or "Pacific Islander").
  90
  91 =cut
  92 #'
  93
  94 sub fixEthnicity($) {
  95
  96     my $ethnicity = shift;
  97     my $dbh = C4::Context->dbh;
  98     my $sth=$dbh->prepare("Select name from ethnicity where code = ?");
  99     $sth->execute($ethnicity);
 100     my $data=$sth->fetchrow_hashref;
 101     $sth->finish;
 102     return $data->{'name'};
 103 }
 104
 105 =head2 borrowercategories
 106
 107   ($codes_arrayref, $labels_hashref) = &borrowercategories();
 108
 109 Looks up the different types of borrowers in the database. Returns two
 110 elements: a reference-to-array, which lists the borrower category
 111 codes, and a reference-to-hash, which maps the borrower category codes
 112 to category descriptions.
 113
 114 =cut
 115 #'
 116
 117 sub borrowercategories {
 118     my $dbh = C4::Context->dbh;
 119     my $sth=$dbh->prepare("Select categorycode,description from categories order by description");
 120     $sth->execute;
 121     my %labels;
 122     my @codes;
 123     while (my $data=$sth->fetchrow_hashref){
 124       push @codes,$data->{'categorycode'};
 125       $labels{$data->{'categorycode'}}=$data->{'description'};
 126     }
 127     $sth->finish;
 128     return(\@codes,\%labels);
 129 }
 130
 131 =head2 ethnicitycategories
 132
 133   ($codes_arrayref, $labels_hashref) = &ethnicitycategories();
 134
 135 Looks up the different ethnic types in the database. Returns two
 136 elements: a reference-to-array, which lists the ethnicity codes, and a
 137 reference-to-hash, which maps the ethnicity codes to ethnicity
 138 descriptions.
 139
 140 =cut
 141 #'
 142
 143 sub ethnicitycategories {
 144     my $dbh = C4::Context->dbh;
 145     my $sth=$dbh->prepare("Select code,name from ethnicity order by name");
 146     $sth->execute;
 147     my %labels;
 148     my @codes;
 149     while (my $data=$sth->fetchrow_hashref){
 150       push @codes,$data->{'code'};
 151       $labels{$data->{'code'}}=$data->{'name'};
 152     }
 153     $sth->finish;
 154     return(\@codes,\%labels);
 155 }
 156
 157 # FIXME.. this should be moved to a MARC-specific module
 158 sub subfield_is_koha_internal_p ($) {
 159     my($subfield) = @_;
 160
 161     # We could match on 'lib' and 'tab' (and 'mandatory', & more to come!)
 162     # But real MARC subfields are always single-character
 163     # so it really is safer just to check the length
 164
 165     return length $subfield != 1;
 166 }
 167
 168 =head2 getbranches
 169
 170   $branches = &getbranches();
 171   returns informations about branches.
 172   Create a branch selector with the following code
 173
 174 =head3 in PERL SCRIPT
 175
 176 my $branches = getbranches;
 177 my @branchloop;
 178 foreach my $thisbranch (keys %$branches) {
 179         my $selected = 1 if $thisbranch eq $branch;
 180         my %row =(value => $thisbranch,
 181                                 selected => $selected,
 182                                 branchname => $branches->{$thisbranch}->{'branchname'},
 183                         );
 184         push @branchloop, \%row;
 185 }
 186
 187
 188 =head3 in TEMPLATE
 189                         <select name="branch">
 190                                 <option value="">Default</option>
 191                         <!-- TMPL_LOOP name="branchloop" -->
 192                                 <option value="<!-- TMPL_VAR name="value" -->" <!-- TMPL_IF name="selected" -->selected<!-- /TMPL_IF -->><!-- TMPL_VAR name="branchname" --></option>
 193                         <!-- /TMPL_LOOP -->
 194                         </select>
 195
 196 =cut
 197
 198 sub getbranches {
 199 # returns a reference to a hash of references to branches...
 200         my %branches;
 201         my $dbh = C4::Context->dbh;
 202         my $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 itemtypes
 225
 226   $itemtypes = &getitemtypes();
 227
 228 Returns information about existing itemtypes.
 229
 230 build a HTML select with the following code :
 231
 232 =head3 in PERL SCRIPT
 233
 234 my $itemtypes = getitemtypes;
 235 my @itemtypesloop;
 236 foreach my $thisitemtype (keys %$itemtypes) {
 237         my $selected = 1 if $thisitemtype eq $itemtype;
 238         my %row =(value => $thisitemtype,
 239                                 selected => $selected,
 240                                 description => $itemtypes->{$thisitemtype}->{'description'},
 241                         );
 242         push @itemtypesloop, \%row;
 243 }
 244 $template->param(itemtypeloop => \@itemtypesloop);
 245
 246 =head3 in TEMPLATE
 247
 248 <form action='<!-- TMPL_VAR name="script_name" -->' method=post>
 249         <select name="itemtype">
 250                 <option value="">Default</option>
 251         <!-- TMPL_LOOP name="itemtypeloop" -->
 252                 <option value="<!-- TMPL_VAR name="value" -->" <!-- TMPL_IF name="selected" -->selected<!-- /TMPL_IF -->><!-- TMPL_VAR name="description" --></option>
 253         <!-- /TMPL_LOOP -->
 254         </select>
 255         <input type=text name=searchfield value="<!-- TMPL_VAR name="searchfield" -->">
 256         <input type="submit" value="OK" class="button">
 257 </form>
 258
 259
 260 =cut
 261
 262 sub getitemtypes {
 263 # returns a reference to a hash of references to branches...
 264         my %itemtypes;
 265         my $dbh = C4::Context->dbh;
 266         my $sth=$dbh->prepare("select * from itemtypes order by description");
 267         $sth->execute;
 268         while (my $IT=$sth->fetchrow_hashref) {
 269                         $itemtypes{$IT->{'itemtype'}}=$IT;
 270         }
 271         return (\%itemtypes);
 272 }
 273
 274
 275 =head2 itemtypes
 276
 277   $itemtype = &getitemtype($itemtype);
 278
 279 Returns information about an itemtype.
 280
 281 =cut
 282
 283 sub getitemtypeinfo {
 284         my ($itemtype) = @_;
 285         my $dbh = C4::Context->dbh;
 286         my $sth=$dbh->prepare("select * from itemtypes where itemtype=?");
 287         $sth->execute($itemtype);
 288         my $res = $sth->fetchrow_hashref;
 289         return $res;
 290 }
 291
 292 =head2 getprinters
 293
 294   $printers = &getprinters($env);
 295   @queues = keys %$printers;
 296
 297 Returns information about existing printer queues.
 298
 299 C<$env> is ignored.
 300
 301 C<$printers> is a reference-to-hash whose keys are the print queues
 302 defined in the printers table of the Koha database. The values are
 303 references-to-hash, whose keys are the fields in the printers table.
 304
 305 =cut
 306
 307 sub getprinters {
 308     my ($env) = @_;
 309     my %printers;
 310     my $dbh = C4::Context->dbh;
 311     my $sth=$dbh->prepare("select * from printers");
 312     $sth->execute;
 313     while (my $printer=$sth->fetchrow_hashref) {
 314         $printers{$printer->{'printqueue'}}=$printer;
 315     }
 316     return (\%printers);
 317 }
 318 sub getbranch ($$) {
 319     my($query, $branches) = @_; # get branch for this query from branches
 320     my $branch = $query->param('branch');
 321     ($branch) || ($branch = $query->cookie('branch'));
 322     ($branches->{$branch}) || ($branch=(keys %$branches)[0]);
 323     return $branch;
 324 }
 325
 326 sub getprinter ($$) {
 327     my($query, $printers) = @_; # get printer for this query from printers
 328     my $printer = $query->param('printer');
 329     ($printer) || ($printer = $query->cookie('printer'));
 330     ($printers->{$printer}) || ($printer = (keys %$printers)[0]);
 331     return $printer;
 332 }
 333
 334
 335 1;
 336 __END__
 337
 338 =back
 339
 340 =head1 AUTHOR
 341
 342 Koha Team
 343
 344 =cut