Tk Library Source Code

Artifact 746dcacd2ed20c809c10c903332c691315f1b0ee:

--- ldap.tcl.org	Wed Oct  6 03:35:21 2004
+++ ldap.tcl	Sun Jul 17 21:54:43 2005
@@ -299,7 +299,7 @@
         ^\\!$ {  #--- not -------------------------------------------
             return [asnChoiceConstr 2 [buildUpFilter [lindex $filter 1]]]           
         } 
-        =\\*$ {  #--- present ---------------------------------------
+        =\\*+$ {  #--- present ---------------------------------------
             set endpos [expr {[string length $first] -3}]
             set attributetype [string range $first 0 $endpos]
             return [asnChoice 7 $attributetype]           
@@ -319,24 +319,46 @@
             return [asnChoiceConstr 5 [asnOctetString $attributetype] \
                                       [asnOctetString $value]         ]
         }
-        ^[0-9A-z.]*=\\*[^*]*\\* {  #--- substrings (any) -----------------
-            regexp {^([0-9A-z.]*)=\*(.*)\*$} $first all attributetype value
-            trace "any substrings: attributetype='$attributetype' value='$value'"
-            return [asnChoiceConstr 4 [asnOctetString $attributetype]     \
-                                      [asnSequence [asnChoice 1 $value] ] ]
-        }
-        ^[0-9A-z.]*=[^*]*\\*$ {  #--- substrings (initial) -------------------
-            regexp {^([0-9A-z.]*)=(.*)\*$} $first all attributetype value
-            trace "initial substrings: attributetype='$attributetype' value='$value'"
-            return [asnChoiceConstr 4 [asnOctetString $attributetype]     \
-                                      [asnSequence [asnChoice 0 $value] ] ]
-        }
-        ^[0-9A-z.]*=\\*[^*]*$ {  #--- substrings (final) -----------------
-            regexp {^([0-9A-z.]*)=\*(.*)$} $first all attributetype value
-            trace "final substrings: attributetype='$attributetype' value='$value'"
-            return [asnChoiceConstr 4 [asnOctetString $attributetype]     \
-                                      [asnSequence [asnChoice 2 $value] ] ]
-        }
+        ^[0-9A-z.]*=.*\\*.* {  #--- substrings -----------------
+            regexp {^([0-9A-z.]*)=(.*)$} $first all attributetype value
+	    regsub -all {\*+} $value {*} value
+	    set value [split $value "*"]
+	    set firstsubstrtype	0		;# initial
+	    set lastsubstrtype	2		;# final
+	    if {[string equal [lindex $value 0] ""]} {
+		set firstsubstrtype 1		;# any
+		set value [lreplace $value 0 0]
+	    }
+	    if {[string equal [lindex $value end] ""]} {
+		set lastsubstrtype 1		;# any
+		set value [lreplace $value end end]
+	    }
+	    set n [llength $value]
+	    set i 1
+	    set l {}
+	    set substrtype 0			;# initial
+	    foreach str $value {
+		if {$i == 1 && $i == $n} {
+		    if {$firstsubstrtype == 0} {
+			set substrtype 0	;# initial
+		    } elseif {$lastsubstrtype == 2} {
+			set substrtype 2	;# final
+		    } else {
+			set substrtype 1	;# any
+		    }
+		} elseif {$i == 1} {
+		    set substrtype $firstsubstrtype
+		} elseif {$i == $n} {
+		    set substrtype $lastsubstrtype
+		} else {
+		    set substrtype 1		;# any
+		}
+		lappend l [asnChoice $substrtype $str]
+		incr i
+	    }
+	    return [asnChoiceConstr 4 [asnOctetString $attributetype]     \
+				      [asnSequenceFromList $l] ]
+	}
         ^[0-9A-z.]*= {  #--- equal ---------------------------------
             regexp {^([0-9A-z.]*)=(.*)$} $first all attributetype value
             trace "equal: attributetype='$attributetype' value='$value'"
@@ -836,8 +858,18 @@
 #-----------------------------------------------------------------------------
 proc ldap::asnSequence { args } {
 
+    return [asnSequenceFromList $args]
+}
+
+
+#-----------------------------------------------------------------------------
+#    asnSequenceFromList
+#
+#-----------------------------------------------------------------------------
+proc ldap::asnSequenceFromList { lst } {
+
     set out ""
-    foreach part $args {
+    foreach part $lst {
         append out $part
     }
     set len [string length $out]