From a6fab5ea0ab731d8ee960bbc2d446daa854be364 Mon Sep 17 00:00:00 2001
From: fukachan <fukachan>
Date: Wed, 17 Jul 2002 09:35:17 +0000
Subject: optionally, we accept case insensitive comparison of user part of the
 mail address.

---
 fml/lib/FML/Credential.pm | 40 ++++++++++++++++++++++++++++++++++++++--
 1 file changed, 38 insertions(+), 2 deletions(-)

diff --git a/fml/lib/FML/Credential.pm b/fml/lib/FML/Credential.pm
index 651a7a2c..75fd68b3 100644
--- a/fml/lib/FML/Credential.pm
+++ b/fml/lib/FML/Credential.pm
@@ -4,7 +4,7 @@
 #   All rights reserved. This program is free software; you can
 #   redistribute it and/or modify it under the same terms as Perl itself.
 #
-# $FML: Credential.pm,v 1.26 2002/06/30 14:27:47 fukachan Exp $
+# $FML: Credential.pm,v 1.27 2002/06/30 14:30:13 fukachan Exp $
 #
 
 package FML::Credential;
@@ -60,6 +60,9 @@ sub new
     # default comparison level
     set_compare_level( $me, 3 );
 
+    # case sensitive for user part comparison.
+    $me->{ _user_part_case_sensitive } = 1;
+
     return bless $me, $type;
 }
 
@@ -71,6 +74,33 @@ sub new
 sub DESTROY {}
 
 
+=head2 ACCESS METHODS
+
+=cut
+
+
+# Descriptions: compare user part case sensitively (default)
+#    Arguments: OBJ($self)
+# Side Effects: none
+# Return Value: none
+sub set_user_part_case_sensitive
+{
+    my ($self) = @_;
+    $self->{ _user_part_case_sensitive } = 1;
+}
+
+
+# Descriptions: compare user part case insensitively (default)
+#    Arguments: OBJ($self)
+# Side Effects: none
+# Return Value: none
+sub set_user_part_case_insensitive
+{
+    my ($self) = @_;
+    $self->{ _user_part_case_sensitive } = 0;
+}
+
+
 =head2 C<is_same_address($addr1, $addr2 [, $level])>
 
 return 1 (same) or 0 (different).
@@ -115,12 +145,18 @@ sub is_same_address
     my ($xuser, $xdomain) = split(/\@/, $xaddr);
     my ($yuser, $ydomain) = split(/\@/, $yaddr);
     my $level             = 0;
+    my $is_case_sensitive = $self->{ _user_part_case_sensitive };
 
     # the max recursive level in comparison
     $max_level = $max_level || $self->{ _max_level } || 3;
 
     # rule 1: case sensitive
-    if ($xuser ne $yuser) { return 0;}
+    if ($is_case_sensitive) {
+	if ($xuser ne $yuser) { return 0;}
+    }
+    else {
+	if ("\L$xuser\E" ne "\L$yuser\E") { return 0;}
+    }
 
     # rule 2: case insensitive
     if ("\L$xdomain\E" eq "\L$ydomain\E") { return 1;}
-- 
cgit v1.2.1