Menu
▾
▴
[WWcvs] pg: Updates to allow string matches to be case-insensitive.
|
From: dpvc v. a. <we...@ma...> - 2005-07-03 20:13:38
|
Log Message:
-----------
Updates to allow string matches to be case-insensitive. This is now
the default, and can be overridden in the Context by setting the
string's "caseSensitive" attribute. e.g.:
Context()->strings->add("FooBar"=>{caseSensitive=>1});
would rewuire "FooBar" to be entered exactly as typed.
Modified Files:
--------------
pg/macros:
contextABCD.pl
contextTF.pl
pg/lib/Parser:
String.pm
pg/lib/Parser/Context:
Default.pm
Strings.pm
pg/lib/Value:
String.pm
Revision Data
-------------
Index: contextABCD.pl
===================================================================
RCS file: /webwork/cvs/system/pg/macros/contextABCD.pl,v
retrieving revision 1.2
retrieving revision 1.3
diff -Lmacros/contextABCD.pl -Lmacros/contextABCD.pl -u -r1.2 -r1.3
--- macros/contextABCD.pl
+++ macros/contextABCD.pl
@@ -32,10 +32,10 @@
$context{ABCD} = Context("String")->copy;
$context{ABCD}->strings->are(
- "A" => {}, "a" => {alias => "A"},
- "B" => {}, "b" => {alias => "B"},
- "C" => {}, "c" => {alias => "C"},
- "D" => {}, "d" => {alias => "D"},
+ "A" => {},
+ "B" => {},
+ "C" => {},
+ "D" => {},
);
$context{'ABCD-List'} = $context{ABCD}->copy;
Index: contextTF.pl
===================================================================
RCS file: /webwork/cvs/system/pg/macros/contextTF.pl,v
retrieving revision 1.3
retrieving revision 1.4
diff -Lmacros/contextTF.pl -Lmacros/contextTF.pl -u -r1.3 -r1.4
--- macros/contextTF.pl
+++ macros/contextTF.pl
@@ -11,7 +11,9 @@
#
# You can add new strings to the context as needed (or remove old ones)
# via the Context()->strings->add() and Context()-strings->remove()
-# methods
+# methods.
+#
+# Use
#
# ANS(string_cmp("T","F"));
#
@@ -20,11 +22,10 @@
$context{TF} = Context("String")->copy;
$context{TF}->strings->are(
- "T" => {value => 1}, "t" => {alias => "T"},
- "F" => {value => 0}, "f" => {alias => "F"},
- "True" => {alias => "T"}, "False" => {alias => "F"},
- "TRUE" => {alias => "T"}, "FALSE" => {alias => "F"},
- "true" => {alias => "T"}, "false" => {alias => "F"},
+ "T" => {value => 1},
+ "F" => {value => 0},
+ "True" => {alias => "T"},
+ "False" => {alias => "F"},
);
Context("TF");
Index: String.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Parser/String.pm,v
retrieving revision 1.7
retrieving revision 1.8
diff -Llib/Parser/String.pm -Llib/Parser/String.pm -u -r1.7 -r1.8
--- lib/Parser/String.pm
+++ lib/Parser/String.pm
@@ -17,6 +17,10 @@
my $equation = shift;
my ($value, $ref) = @_;
my $def = $equation->{context}{strings}{$value};
+ unless ($def) {
+ $def = $equation->{context}{strings}{uc($value)};
+ $def = undef if $def->{caseSensitive} && $value ne uc($value);
+ }
$value = $def->{alias}, $def = $equation->{context}{strings}{$value}
if defined($def->{alias});
my $str = bless {
Index: Strings.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Parser/Context/Strings.pm,v
retrieving revision 1.4
retrieving revision 1.5
diff -Llib/Parser/Context/Strings.pm -Llib/Parser/Context/Strings.pm -u -r1.4 -r1.5
--- lib/Parser/Context/Strings.pm
+++ lib/Parser/Context/Strings.pm
@@ -15,6 +15,72 @@
$self->{namePattern} = '[\S ]+';
}
+#
+# Allow for case-insensitive strings.
+# Case-insensitive is now the default.
+# You can use
+#
+# $context->strings->set(name=>{caseSensitive=>1});
+#
+# to get a case-sensitive string called "name".
+#
+sub update {
+ my $self = shift;
+ my $data = $self->{context}->{$self->{dataName}};
+ my $single = ''; my @multi = ();
+ foreach my $x (sort Value::Context::Data::byName (keys %{$data})) {
+ unless ($data->{$x}{hidden}) {
+ if ($data->{$x}{caseSensitive} || uc($x) eq lc($x)) {
+ if (length($x) == 1) {$single .= $x}
+ else {push(@multi,protectRegexp($x))}
+ } else {
+ if (length($x) == 1) {$single .= uc($x).lc($x)}
+ else {push(@multi,"(?:(?i)".protectRegexp($x).")")}
+ }
+ }
+ }
+ $self->{pattern} = $self->getPattern($single,@multi);
+ $self->{context}->update;
+}
+
+#
+# Same as Value::Context::Data::getPattern, but with
+# the protectRegexp already done on the @multi list.
+#
+sub getPattern {
+ shift; my $s = shift;
+# foreach my $x (@_) {$x = protectRegexp($x)}
+ my @pattern = ();
+ push(@pattern,join('|',@_)) if scalar(@_) > 0;
+ push(@pattern,protectRegexp($s)) if length($s) == 1;
+ push(@pattern,"[".protectChars($s)."]") if length($s) > 1;
+ my $pattern = join('|',@pattern);
+ $pattern = '^$' if $pattern eq '';
+ return $pattern;
+}
+
+#
+# Add lower-case alias for case-insensitive strings
+# (so we can always find their definitions)
+#
+sub add {
+ my $self = shift; return if scalar(@_) == 0;
+ my $data = $self->{context}{$self->{dataName}};
+ $self->SUPER::add(@_);
+ my %D = (@_);
+ foreach my $x (keys %D) {
+ $data->{uc($x)} = {alias => $x}
+ unless $data->{$x}{caseSensitive} || uc($x) eq $x;
+ }
+}
+
+#
+# Call the ones in Value::Context::Data
+#
+sub protectRegexp {Value::Context::Data::protectRegexp(@_)}
+sub protectChars {Value::Context::Data::protectChars(@_)}
+
+
#########################################################################
1;
Index: Default.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Parser/Context/Default.pm,v
retrieving revision 1.25
retrieving revision 1.26
diff -Llib/Parser/Context/Default.pm -Llib/Parser/Context/Default.pm -u -r1.25 -r1.26
--- lib/Parser/Context/Default.pm
+++ lib/Parser/Context/Default.pm
@@ -182,16 +182,9 @@
$strings = {
'infinity' => {infinite => 1},
- 'INFINITY' => {alias => 'infinity'},
'inf' => {alias => 'infinity'},
- 'INF' => {alias => 'infinity'},
-
'NONE' => {},
- 'none' => {alias => 'NONE'},
-
'DNE' => {},
- 'dne' => {alias => 'DNE'},
-
# 'T' => {true => 1},
# 'F' => {false => 1},
};
Index: String.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Value/String.pm,v
retrieving revision 1.5
retrieving revision 1.6
diff -Llib/Value/String.pm -Llib/Value/String.pm -u -r1.5 -r1.6
--- lib/Value/String.pm
+++ lib/Value/String.pm
@@ -20,11 +20,18 @@
sub new {
my $self = shift; my $class = ref($self) || $self;
my $x = join('',@_);
+ my $s = bless {data => [$x]}, $class;
if ($Parser::installed) {
- Value::Error("String constant '$x' is not defined in this context")
- unless $$Value::context->{strings}{$x};
+ my $strings = $$Value::context->{strings};
+ if (!$strings->{$x}) {
+ my $X = $strings->{uc($x)};
+ Value::Error("String constant '$x' is not defined in this context")
+ unless $X && !$X->{caseSensitive};
+ $x = uc($x); while ($strings->{$x}{alias}) {$x = $strings->{$x}{alias}}
+ }
+ $s->{caseSensitive} = 1 if $strings->{$x}{caseSensitive};
}
- bless {data => [$x]}, $class;
+ return $s;
}
#
@@ -53,12 +60,12 @@
#
# Operations on strings
#
-
sub compare {
my ($l,$r,$flag) = @_;
if ($l->promotePrecedence($r)) {return $r->compare($l,!$flag)}
$r = promote($r); if ($flag) {my $tmp = $l; $l = $r; $r = $tmp}
- return $l->value cmp $r->value;
+ return $l->value cmp $r->value if $l->{caseSensitive} || $r->{caseSensitive};
+ return uc($l->value) cmp uc($r->value);
}
############################################
|
