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 use CGI;
  25
  26 use vars qw($VERSION @ISA @EXPORT);
  27
  28 # set the version for version checking
  29 $VERSION = 0.01;
  30
  31 =head1 NAME
  32
  33 C4::Input - Miscellaneous sanity checks
  34
  35 =head1 SYNOPSIS
  36
  37   use C4::Input;
  38
  39 =head1 DESCRIPTION
  40
  41 This module provides functions to see whether a given library card
  42 number or ISBN is valid.
  43
  44 =head1 FUNCTIONS
  45
  46 =over 2
  47
  48 =cut
  49
  50 @ISA = qw(Exporter);
  51 @EXPORT = qw(
  52         &checkdigit &checkvalidisbn
  53         &buildCGIsort
  54 );
  55
  56 =item checkdigit
  57
  58   $valid = &checkdigit($cardnumber $nounique);
  59
  60 Takes a card number, computes its check digit, and compares it to the
  61 checkdigit at the end of C<$cardnumber>. Returns a true value iff
  62 C<$cardnumber> has a valid check digit.
  63
  64 =cut
  65 #'
  66 sub checkdigit {
  67
  68         my ($infl, $nounique) =  @_;
  69         $infl = uc $infl;
  70
  71
  72         #Check to make sure the cardnumber is unique
  73
  74         #FIXME: We should make the error for a nonunique cardnumber
  75         #different from the one where the checkdigit on the number is
  76         #not correct
  77
  78         unless ( $nounique )
  79         {
  80                 my $dbh=C4::Context->dbh;
  81                 my $query=qq{SELECT * FROM borrowers WHERE cardnumber=?};
  82                 my $sth=$dbh->prepare($query);
  83                 $sth->execute($infl);
  84                 my %results = $sth->fetchrow_hashref();
  85                 if ( $sth->rows != 0 )
  86                 {
  87                         return 0;
  88                 }
  89         }
  90         if (C4::Context->preference("checkdigit") eq "none") {
  91                 return 1;
  92         }
  93
  94         my @weightings = (8,4,6,3,5,2,1);
  95         my $sum;
  96         my $i = 1;
  97         my $valid = 0;
  98
  99         foreach $i (1..7) {
 100                 my $temp1 = $weightings[$i-1];
 101                 my $temp2 = substr($infl,$i,1);
 102                 $sum += $temp1 * $temp2;
 103         }
 104         my $rem = ($sum%11);
 105         if ($rem == 10) {
 106         $rem = "X";
 107         }
 108         if ($rem eq substr($infl,8,1)) {
 109                 $valid = 1;
 110         }
 111         return $valid;
 112 } # sub checkdigit
 113
 114 =item checkvalidisbn
 115
 116   $valid = &checkvalidisbn($isbn);
 117
 118 Returns a true value iff C<$isbn> is a valid ISBN: it must be ten
 119 digits long (counting "X" as a digit), and must have a valid check
 120 digit at the end.
 121
 122 =cut
 123 #'
 124 #--------------------------------------
 125 # Determine if a number is a valid ISBN number, according to length
 126 #   of 10 digits and valid checksum
 127 sub checkvalidisbn {
 128         use strict;
 129         my ($q)=@_ ;    # Input: ISBN number
 130
 131         my $isbngood = 0; # Return: true or false
 132
 133         $q=~s/x$/X/g;   # upshift lower case X
 134         $q=~s/[^X\d]//g;
 135         $q=~s/X.//g;
 136
 137                 #return 0 if $q is not ten digits long
 138                 if (length($q)!=10) {
 139                         return 0;
 140                 }
 141
 142                 #If we get to here, length($q) must be 10
 143         my $checksum=substr($q,9,1);
 144         my $isbn=substr($q,0,9);
 145         my $i;
 146         my $c=0;
 147         for ($i=0; $i<9; $i++) {
 148                 my $digit=substr($q,$i,1);
 149                 $c+=$digit*(10-$i);
 150         }
 151         $c %= 11;
 152         ($c==10) && ($c='X');
 153         $isbngood = $c eq $checksum;
 154         return $isbngood;
 155
 156 } # sub checkvalidisbn
 157
 158 =item buildCGISort
 159
 160   $CGIScrollingList = &BuildCGISort($name string, $input_name string);
 161
 162 Returns the scrolling list with name $input_name, built on authorised Values named $name.
 163 Returns NULL if no authorised values found
 164
 165 =cut
 166 sub buildCGIsort {
 167     use strict;
 168         my ($name,$input_name,$data) = @_;
 169         my $dbh=C4::Context->dbh;
 170         my $query=qq{SELECT * FROM authorised_values WHERE category=? order by lib};
 171         my $sth=$dbh->prepare($query);
 172         $sth->execute($name);
 173         my $CGISort;
 174         if ($sth->rows>0){
 175                 my @values;
 176                 my %labels;
 177
 178                 for (my $i =0;$i<$sth->rows;$i++){
 179                         my $results = $sth->fetchrow_hashref;
 180                         push @values, $results->{authorised_value};
 181                         $labels{$results->{authorised_value}}=$results->{lib};
 182                 }
 183                 unshift(@values,"");
 184                 $CGISort= CGI::scrolling_list(
 185                                         -name => $input_name,
 186                                         -values => \@values,
 187                                         -labels => \%labels,
 188                                         -default=> $data,
 189                                         -size => 1,
 190                                         -multiple => 0);
 191         }
 192         $sth->finish;
 193         return $CGISort;
 194 }
 195 END { }       # module clean-up code here (global destructor)
 196
 197 1;
 198 __END__
 199
 200 =back
 201
 202 =head1 AUTHOR
 203
 204 Koha Developement team <info@koha.org>
 205
 206 =cut