File: | C4/Input.pm |
Coverage: | 29.3% |
line | stmt | bran | cond | sub | time | code |
---|---|---|---|---|---|---|
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 | |||||
18 | # with Koha; if not, write to the Free Software Foundation, Inc., | |||||
19 | # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. | |||||
20 | ||||||
21 | 3 3 3 | 293 8 71 | use strict; | |||
22 | 3 3 3 | 17 6 167 | use warnings; | |||
23 | ||||||
24 | require Exporter; | |||||
25 | 3 3 3 | 327 33 84 | use C4::Context; | |||
26 | 3 3 3 | 273 27143 98 | use CGI; | |||
27 | ||||||
28 | 3 3 3 | 238 43 1547 | use vars qw($VERSION @ISA @EXPORT); | |||
29 | ||||||
30 | # set the version for version checking | |||||
31 | $VERSION = 0.01; | |||||
32 | ||||||
33 - 50 | =head1 NAME C4::Input - Miscellaneous sanity checks =head1 SYNOPSIS use C4::Input; =head1 DESCRIPTION This module provides functions to see whether a given library card number or ISBN is valid. =head1 FUNCTIONS =over 2 =cut | |||||
51 | ||||||
52 | @ISA = qw(Exporter); | |||||
53 | @EXPORT = qw( | |||||
54 | &checkdigit | |||||
55 | &buildCGIsort | |||||
56 | ); | |||||
57 | ||||||
58 - 66 | =item checkdigit $valid = &checkdigit($cardnumber $nounique); Takes a card number, computes its check digit, and compares it to the checkdigit at the end of C<$cardnumber>. Returns a true value iff C<$cardnumber> has a valid check digit. =cut | |||||
67 | ||||||
68 | #' | |||||
69 | sub checkdigit ($;$) { | |||||
70 | ||||||
71 | 0 | my ($infl, $nounique) = @_; | ||||
72 | 0 | $infl = uc $infl; | ||||
73 | ||||||
74 | # Check to make sure the cardnumber is unique | |||||
75 | ||||||
76 | #FIXME: We should make the error for a nonunique cardnumber | |||||
77 | #different from the one where the checkdigit on the number is | |||||
78 | #not correct | |||||
79 | ||||||
80 | 0 | unless ( $nounique ) | ||||
81 | { | |||||
82 | 0 | my $query=qq{SELECT * FROM borrowers WHERE cardnumber=?}; | ||||
83 | 0 | my $sth=C4::Context->prepare($query); | ||||
84 | 0 | $sth->execute($infl); | ||||
85 | 0 | my %results = $sth->fetchrow_hashref(); | ||||
86 | 0 | if ( $sth->rows != 0 ) | ||||
87 | { | |||||
88 | 0 | return 0; | ||||
89 | } | |||||
90 | } | |||||
91 | 0 | if (C4::Context->preference("checkdigit") eq "none") { | ||||
92 | 0 | return 1; | ||||
93 | } | |||||
94 | ||||||
95 | 0 | my @weightings = (8,4,6,3,5,2,1); | ||||
96 | 0 | my $sum; | ||||
97 | 0 | foreach my $i (1..7) { | ||||
98 | 0 | my $temp1 = $weightings[$i-1]; | ||||
99 | 0 | my $temp2 = substr($infl,$i,1); | ||||
100 | 0 | $sum += $temp1 * $temp2; | ||||
101 | } | |||||
102 | 0 | my $rem = ($sum%11); | ||||
103 | 0 | if ($rem == 10) { | ||||
104 | 0 | $rem = "X"; | ||||
105 | } | |||||
106 | 0 | if ($rem eq substr($infl,8,1)) { | ||||
107 | 0 | return 1; | ||||
108 | } | |||||
109 | 0 | return 0; | ||||
110 | } # sub checkdigit | |||||
111 | ||||||
112 - 119 | =item buildCGISort $CGIScrollingList = &buildCGISort($name string, $input_name string); Returns the scrolling list with name $input_name, built on authorised Values named $name. Returns NULL if no authorised values found =cut | |||||
120 | ||||||
121 | sub buildCGIsort { | |||||
122 | 0 | my ($name,$input_name,$data) = @_; | ||||
123 | 0 | my $dbh=C4::Context->dbh; | ||||
124 | 0 | my $query=qq{SELECT * FROM authorised_values WHERE category=? order by lib}; | ||||
125 | 0 | my $sth=$dbh->prepare($query); | ||||
126 | 0 | $sth->execute($name); | ||||
127 | 0 | my $CGISort; | ||||
128 | 0 | if ($sth->rows>0){ | ||||
129 | 0 | my @values; | ||||
130 | 0 | my %labels; | ||||
131 | ||||||
132 | for (my $i =0;$i<$sth->rows;$i++){ | |||||
133 | 0 | my $results = $sth->fetchrow_hashref; | ||||
134 | 0 | push @values, $results->{authorised_value}; | ||||
135 | 0 | $labels{$results->{authorised_value}}=$results->{lib}; | ||||
136 | 0 | } | ||||
137 | 0 | $CGISort= CGI::scrolling_list( | ||||
138 | -name => $input_name, | |||||
139 | -id => $input_name, | |||||
140 | -values => \@values, | |||||
141 | -labels => \%labels, | |||||
142 | -default=> $data, | |||||
143 | -size => 1, | |||||
144 | -multiple => 0); | |||||
145 | } | |||||
146 | 0 | $sth->finish; | ||||
147 | 0 | return $CGISort; | ||||
148 | } | |||||
149 | 3 | 856757 | END { } # module clean-up code here (global destructor) | |||
150 | ||||||
151 | 1; |