X-Git-Url: http://koha-dev.rot13.org:8081/gitweb/?a=blobdiff_plain;f=C4%2FInput.pm;h=2ee07f3f61bebb6f204e8cdb7a9e164dc2f0aa58;hb=47fac215afbedab7bdad9172d1f002488cd35df1;hp=330fc544925b0286335f8b4984839e5697a2e4f7;hpb=d0374d003716dfb40796caad6390a4d69bfb0376;p=koha_gimpoz diff --git a/C4/Input.pm b/C4/Input.pm index 330fc54492..2ee07f3f61 100644 --- a/C4/Input.pm +++ b/C4/Input.pm @@ -1,92 +1,160 @@ -package C4::Input; #asummes C4/Input - -#package to deal with marking up output +package C4::Input; #assumes C4/Input + + +# Copyright 2000-2002 Katipo Communications +# +# This file is part of Koha. +# +# Koha is free software; you can redistribute it and/or modify it under the +# terms of the GNU General Public License as published by the Free Software +# Foundation; either version 2 of the License, or (at your option) any later +# version. +# +# Koha is distributed in the hope that it will be useful, but WITHOUT ANY +# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR +# A PARTICULAR PURPOSE. See the GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License along +# with Koha; if not, write to the Free Software Foundation, Inc., +# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. use strict; +use warnings; + require Exporter; +use C4::Context; +use CGI; -use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); +use vars qw($VERSION @ISA @EXPORT); # set the version for version checking $VERSION = 0.01; -@ISA = qw(Exporter); -@EXPORT = qw(&checkflds &checkdigit); -%EXPORT_TAGS = ( ); # eg: TAG => [ qw!name1 name2! ], - -# your exported package globals go here, -# as well as any optionally exported functions - -@EXPORT_OK = qw($Var1 %Hashit); - - -# non-exported package globals go here -use vars qw(@more $stuff); - -# initalize package globals, first exported ones - -my $Var1 = ''; -my %Hashit = (); - - -# then the others (which are still accessible as $Some::Module::stuff) -my $stuff = ''; -my @more = (); - -# all file-scoped lexicals must be created before -# the functions below that use them. - -# file-private lexicals go here -my $priv_var = ''; -my %secret_hash = (); - -# here's a file-private function as a closure, -# callable as &$priv_func; it cannot be prototyped. -my $priv_func = sub { -# stuff goes here. - }; - -# make all your functions, whether exported or not; - -sub checkflds { - my ($env,$reqflds,$data) = @_; - my $numrflds = @$reqflds; - my @probarr; - my $i = 0; - while ($i < $numrflds) { - if ($data->{@$reqflds[$i]} eq "") { - push(@probarr, @$reqflds[$i]); - } - $i++ - } - return (\@probarr); -} +=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. -sub checkdigit { - my ($env,$infl) = @_; - $infl = uc $infl; - my @weightings = (8,4,6,3,5,2,1); - my $sum; - my $i = 1; - my $valid = 0; - # print $infl."
"; - while ($i <8) { - my $temp1 = $weightings[$i-1]; - my $temp2 = substr($infl,$i,1); - $sum = $sum + ($temp1*$temp2); -# print "$sum $temp1 $temp2
"; - $i++; - } - my $rem = ($sum%11); - if ($rem == 10) { - $rem = "X"; - } - #print $rem."
"; - if ($rem eq substr($infl,8,1)) { - $valid = 1; - } - return $valid; +=head1 FUNCTIONS + +=over 2 + +=cut + +@ISA = qw(Exporter); +@EXPORT = qw( + &checkdigit + &buildCGIsort +); + +=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 + +#' +sub checkdigit ($;$) { + + my ($infl, $nounique) = @_; + $infl = uc $infl; + + # Check to make sure the cardnumber is unique + + #FIXME: We should make the error for a nonunique cardnumber + #different from the one where the checkdigit on the number is + #not correct + + unless ( $nounique ) + { + my $query=qq{SELECT * FROM borrowers WHERE cardnumber=?}; + my $sth=C4::Context->prepare($query); + $sth->execute($infl); + my %results = $sth->fetchrow_hashref(); + if ( $sth->rows != 0 ) + { + return 0; + } + } + if (C4::Context->preference("checkdigit") eq "none") { + return 1; + } + + my @weightings = (8,4,6,3,5,2,1); + my $sum; + foreach my $i (1..7) { + my $temp1 = $weightings[$i-1]; + my $temp2 = substr($infl,$i,1); + $sum += $temp1 * $temp2; + } + my $rem = ($sum%11); + if ($rem == 10) { + $rem = "X"; + } + if ($rem eq substr($infl,8,1)) { + return 1; + } + return 0; +} # sub checkdigit + +=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 + +sub buildCGIsort { + my ($name,$input_name,$data) = @_; + my $dbh=C4::Context->dbh; + my $query=qq{SELECT * FROM authorised_values WHERE category=? order by lib}; + my $sth=$dbh->prepare($query); + $sth->execute($name); + my $CGISort; + if ($sth->rows>0){ + my @values; + my %labels; + + for (my $i =0;$i<$sth->rows;$i++){ + my $results = $sth->fetchrow_hashref; + push @values, $results->{authorised_value}; + $labels{$results->{authorised_value}}=$results->{lib}; + } + $CGISort= CGI::scrolling_list( + -name => $input_name, + -id => $input_name, + -values => \@values, + -labels => \%labels, + -default=> $data, + -size => 1, + -multiple => 0); + } + $sth->finish; + return $CGISort; } - END { } # module clean-up code here (global destructor) - + +1; +__END__ + +=back + +=head1 AUTHOR + +Koha Development Team + +=cut