C4/Input.pm

   1 package C4::Input; #assumes C4/Input
   2
   3
   4 # Copyright 2000-2002 Katipo Communications
   5 #
   6 # This file is part of Koha.
   7 #
   8 # Koha is free software; you can redistribute it and/or modify it under the
   9 # terms of the GNU General Public License as published by the Free Software
  10 # Foundation; either version 2 of the License, or (at your option) any later
  11 # version.
  12 #
  13 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
  14 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
  15 # A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
  16 #
  17 # You should have received a copy of the GNU General Public License along with
  18 # Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
  19 # Suite 330, Boston, MA  02111-1307 USA
  20
  21 use strict;
  22 require Exporter;
  23 use C4::Context;
  24
  25 use vars qw($VERSION @ISA @EXPORT);
  26
  27 # set the version for version checking
  28 $VERSION = 0.01;
  29
  30 =head1 NAME
  31
  32 C4::Input - Miscellaneous sanity checks
  33
  34 =head1 SYNOPSIS
  35
  36   use C4::Input;
  37
  38 =head1 DESCRIPTION
  39
  40 This module provides functions to see whether a given library card
  41 number or ISBN is valid.
  42
  43 =head1 FUNCTIONS
  44
  45 =over 2
  46
  47 =cut
  48
  49 @ISA = qw(Exporter);
  50 @EXPORT = qw(
  51         &checkdigit &checkvalidisbn
  52         &buildCGIsort
  53 );
  54
  55 # FIXME - This is never used.
  56 #sub checkflds {
  57 #  my ($env,$reqflds,$data) = @_;
  58 #  my $numrflds = @$reqflds;
  59 #  my @probarr;
  60 #  my $i = 0;
  61 #  while ($i < $numrflds) {
  62 #    if ($data->{@$reqflds[$i]} eq "") {
  63 #      push(@probarr, @$reqflds[$i]);
  64 #    }
  65 #    $i++
  66 #  }
  67 #  return (\@probarr);
  68 #}
  69
  70 =item checkdigit
  71
  72   $valid = &checkdigit($env, $cardnumber $nounique);
  73
  74 Takes a card number, computes its check digit, and compares it to the
  75 checkdigit at the end of C<$cardnumber>. Returns a true value iff
  76 C<$cardnumber> has a valid check digit.
  77
  78 C<$env> is ignored.
  79
  80 =cut
  81 #'
  82 sub checkdigit {
  83
  84         my ($env,$infl, $nounique) =  @_;
  85         $infl = uc $infl;
  86
  87
  88         #Check to make sure the cardnumber is unique
  89
  90         #FIXME: We should make the error for a nonunique cardnumber
  91         #different from the one where the checkdigit on the number is
  92         #not correct
  93
  94         unless ( $nounique )
  95         {
  96                 my $dbh=C4::Context->dbh;
  97                 my $query=qq{SELECT * FROM borrowers WHERE cardnumber=?};
  98                 my $sth=$dbh->prepare($query);
  99                 $sth->execute($infl);
 100                 my %results = $sth->fetchrow_hashref();
 101                 if ( $sth->rows != 0 )
 102                 {
 103                         return 0;
 104                 }
 105         }
 106         if (C4::Context->preference("checkdigit") eq "none") {
 107                 return 1;
 108         }
 109
 110         my @weightings = (8,4,6,3,5,2,1);
 111         my $sum;
 112         my $i = 1;
 113         my $valid = 0;
 114
 115         foreach $i (1..7) {
 116                 my $temp1 = $weightings[$i-1];
 117                 my $temp2 = substr($infl,$i,1);
 118                 $sum += $temp1 * $temp2;
 119         }
 120         my $rem = ($sum%11);
 121         if ($rem == 10) {
 122         $rem = "X";
 123         }
 124         if ($rem eq substr($infl,8,1)) {
 125                 $valid = 1;
 126         }
 127         return $valid;
 128 } # sub checkdigit
 129
 130 =item checkvalidisbn
 131
 132   $valid = &checkvalidisbn($isbn);
 133
 134 Returns a true value iff C<$isbn> is a valid ISBN: it must be ten
 135 digits long (counting "X" as a digit), and must have a valid check
 136 digit at the end.
 137
 138 =cut
 139 #'
 140 #--------------------------------------
 141 # Determine if a number is a valid ISBN number, according to length
 142 #   of 10 digits and valid checksum
 143 sub checkvalidisbn {
 144         use strict;
 145         my ($q)=@_ ;    # Input: ISBN number
 146
 147         my $isbngood = 0; # Return: true or false
 148
 149         $q=~s/x$/X/g;   # upshift lower case X
 150         $q=~s/[^X\d]//g;
 151         $q=~s/X.//g;
 152
 153                 #return 0 if $q is not ten digits long
 154                 if (length($q)!=10) {
 155                         return 0;
 156                 }
 157
 158                 #If we get to here, length($q) must be 10
 159         my $checksum=substr($q,9,1);
 160         my $isbn=substr($q,0,9);
 161         my $i;
 162         my $c=0;
 163         for ($i=0; $i<9; $i++) {
 164                 my $digit=substr($q,$i,1);
 165                 $c+=$digit*(10-$i);
 166         }
 167         $c %= 11;
 168         ($c==10) && ($c='X');
 169         $isbngood = $c eq $checksum;
 170         return $isbngood;
 171
 172 } # sub checkvalidisbn
 173
 174 =item buildCGISort
 175
 176   $CGIScrollingList = &BuildCGISort($name string, $input_name string);
 177
 178 Returns the scrolling list with name $input_name, built on authorised Values named $name.
 179 Returns NULL if no authorised values found
 180
 181 =cut
 182 sub buildCGIsort {
 183     use strict;
 184         my ($name,$input_name,$data) = @_;
 185         my $dbh=C4::Context->dbh;
 186         my $query=qq{SELECT * FROM authorised_values WHERE category=? order by lib};
 187         my $sth=$dbh->prepare($query);
 188         $sth->execute($name);
 189         my $CGISort;
 190         if ($sth->rows>0){
 191                 my @values;
 192                 my %labels;
 193                 for (my $i =0;$i<=$sth->rows;$i++){
 194                         my $results = $sth->fetchrow_hashref;
 195                         push @values, $results->{authorised_value};
 196                         $labels{$results->{authorised_value}}=$results->{lib};
 197                 }
 198                 $CGISort= CGI::scrolling_list(
 199                                         -name => $input_name,
 200                                         -values => \@values,
 201                                         -labels => \%labels,
 202                                         -default=> $data,
 203                                         -size => 1,
 204                                         -multiple => 0);
 205         }
 206         $sth->finish;
 207         return $CGISort;
 208 }
 209 END { }       # module clean-up code here (global destructor)
 210
 211 1;
 212 __END__
 213
 214 =back
 215
 216 =head1 AUTHOR
 217
 218 Koha Developement team <info@koha.org>
 219
 220 =cut