acli
22 years ago
2 changed files with 216 additions and 0 deletions
@ -0,0 +1,124 @@ |
|||
package C4::Boolean; |
|||
|
|||
# $Id$ |
|||
|
|||
#package to handle Boolean values in the parameters table |
|||
# Note: This is just a utility module; it should not be instantiated. |
|||
|
|||
|
|||
# Copyright 2003 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., 59 Temple Place, |
|||
# Suite 330, Boston, MA 02111-1307 USA |
|||
|
|||
use strict; |
|||
use POSIX; |
|||
require Exporter; |
|||
|
|||
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK); |
|||
|
|||
# set the version for version checking |
|||
$VERSION = 0.01; |
|||
|
|||
=head1 NAME |
|||
|
|||
C4::Boolean - Convenience functions to handle boolean values |
|||
in the parameter table |
|||
|
|||
=head1 SYNOPSIS |
|||
|
|||
use C4::Boolean; |
|||
|
|||
=head1 DESCRIPTION |
|||
|
|||
In the parameter table, there are various Boolean values that |
|||
variously require a 0/1, no/yes, false/true, or off/on values. |
|||
This module aims to provide scripts a means to interpret these |
|||
Boolean values in a consistent way which makes common sense. |
|||
|
|||
=head1 FUNCTIONS |
|||
|
|||
=over 2 |
|||
|
|||
=cut |
|||
|
|||
@ISA = qw(Exporter); |
|||
@EXPORT = ( |
|||
&INVALID_BOOLEAN_STRING_EXCEPTION |
|||
); |
|||
|
|||
@EXPORT_OK = qw( |
|||
true_p |
|||
); |
|||
|
|||
sub INVALID_BOOLEAN_STRING_EXCEPTION () |
|||
{ 'The given value does not seem to be interpretable as a Boolean value' } |
|||
|
|||
use vars qw( %strings ); |
|||
|
|||
%strings = ( |
|||
'0' => 0, '1' => 1, # C |
|||
'-1' => 1, # BASIC |
|||
'nil' => 0, 't' => 1, # LISP |
|||
'false' => 0, 'true' => 1, # Pascal |
|||
'off' => 0, 'on' => 1, |
|||
'no' => 0, 'yes' => 1, |
|||
'n' => 0, 'y' => 1, |
|||
); |
|||
|
|||
=item true_p |
|||
|
|||
if ( C4::Boolean::true_p(C4::Context->preference("insecure")) ) { |
|||
... |
|||
} |
|||
|
|||
Tries to interpret the passed string as a Boolean value. Returns |
|||
the value if the string can be interpreted as such; otherwise an |
|||
exception is thrown. |
|||
|
|||
=cut |
|||
|
|||
require '/u/acli/lib/cvs.pl'; |
|||
sub true_p ($) { |
|||
my($x) = @_; |
|||
my $it; |
|||
if (!defined $x || ref($x) ne '') { |
|||
die INVALID_BOOLEAN_STRING_EXCEPTION; |
|||
} |
|||
$x = lc($x); |
|||
$x =~ s/\s//g; |
|||
if (defined $strings{$x}) { |
|||
$it = $strings{$x}; |
|||
} else { |
|||
die INVALID_BOOLEAN_STRING_EXCEPTION; |
|||
} |
|||
return $it; |
|||
} |
|||
|
|||
|
|||
#--------------------------------- |
|||
|
|||
END { } # module clean-up code here (global destructor) |
|||
|
|||
1; |
|||
__END__ |
|||
|
|||
=back |
|||
|
|||
=head1 AUTHOR |
|||
|
|||
Koha Developement team <info@koha.org> |
|||
|
|||
=cut |
@ -0,0 +1,92 @@ |
|||
use strict; |
|||
use C4::Boolean; |
|||
|
|||
use vars qw( @tests ); |
|||
use vars qw( $loaded ); |
|||
|
|||
sub f ($) { |
|||
my($x) = @_; |
|||
my $it; |
|||
# Returns either the value returned prefixed with 'OK:', |
|||
# or the caught exception (string expected) |
|||
local($@); |
|||
eval { |
|||
$it = 'OK:' . C4::Boolean::true_p($x); |
|||
}; |
|||
if ($@) { |
|||
$it = $@; |
|||
$it =~ s/ at \S+ line \d+$\.\n//s; |
|||
} |
|||
return $it; |
|||
} |
|||
|
|||
BEGIN { |
|||
@tests = ( |
|||
[ |
|||
'control', |
|||
sub { C4::Boolean::INVALID_BOOLEAN_STRING_EXCEPTION }, |
|||
'The given value does not seem to be interpretable as a Boolean value', |
|||
undef |
|||
|
|||
# False strings |
|||
], [ |
|||
'"0"', \&f, 'OK:0', '0' |
|||
], [ |
|||
'"false"', \&f, 'OK:0', 'false' |
|||
], [ |
|||
'"off"', \&f, 'OK:0', 'off' |
|||
], [ |
|||
'"no"', \&f, 'OK:0', 'no' |
|||
|
|||
# True strings |
|||
], [ |
|||
'"1"', \&f, 'OK:1', '1' |
|||
], [ |
|||
'"true"', \&f, 'OK:1', 'true' |
|||
], [ |
|||
'"on"', \&f, 'OK:1', 'on' |
|||
], [ |
|||
'"yes"', \&f, 'OK:1', 'yes' |
|||
], [ |
|||
'"YES"', \&f, 'OK:1', 'YES' # verify case insensitivity |
|||
|
|||
# Illegal strings |
|||
], [ |
|||
'undef', \&f, C4::Boolean::INVALID_BOOLEAN_STRING_EXCEPTION, undef |
|||
], [ |
|||
'"foo"', \&f, C4::Boolean::INVALID_BOOLEAN_STRING_EXCEPTION, 'foo' |
|||
], |
|||
); |
|||
} |
|||
|
|||
BEGIN { $| = 1; printf "1..%d\n", scalar(@tests); } |
|||
END {print "not ok 1\n" unless $loaded;} |
|||
$loaded = 1; |
|||
|
|||
|
|||
# Run all tests in sequence |
|||
for (my $i = 1; $i <= scalar @tests; $i += 1) { |
|||
my $test = $tests[$i - 1]; |
|||
my($title, $f, $expected, $input) = @$test; |
|||
die "not ok $i (malformed test case)\n" |
|||
unless @$test == 4 && ref $f eq 'CODE'; |
|||
|
|||
my $output = &$f($input); |
|||
if ( |
|||
(!defined $output && !defined $expected) |
|||
|| (defined $output && defined $expected && $output eq $expected) |
|||
) { |
|||
print "ok $i - $title\n"; |
|||
} else { |
|||
print "not ok $i - $title: got ", |
|||
(defined $output? "\"$output\"": 'undef'), |
|||
', expected ', |
|||
(defined $expected? "\"$expected\"": 'undef'), |
|||
"\n"; |
|||
} |
|||
} |
|||
|
|||
|
|||
|
|||
|
|||
|
Loading…
Reference in new issue