Posted to tcl by mjanssen at Wed Dec 19 16:59:59 GMT 2007view raw

  1. # include procs
  2.  
  3. proc ldap::parseFilter {filterString} {
  4. if {![regexp -- {^\((.*)\)$} $filterString -> filterComp]} {
  5. error "invalid filter string: syntax is \"( ..... )\""
  6. }
  7. return [parseFilterComp $filterComp]
  8. }
  9.  
  10. proc ldap::parseFilterComp {filterComp} {
  11. set first [string index $filterComp 0]
  12. set rest [string range $filterComp 1 end]
  13. switch -- $first {
  14. & -
  15. | -
  16. ! {
  17. return [linsert [parseFilterList $rest] 0 $first]
  18. }
  19. default {
  20. # we have an item return as a single element list
  21. return [string map {"\\(" "(" "\\)" ")"} $filterComp]
  22. }
  23. }
  24. }
  25.  
  26. proc ldap::parseFilterList {filterList} {
  27. puts "pfl: $filterList"
  28. set filters {}
  29. if {[string length $filterList] == 0} {
  30. return {}
  31. }
  32. if {[string index $filterList 0]!="("} {
  33. error "invalid filter component, syntax \"( ....\""
  34. } else {
  35. set filter [ldap::getFilterListElement filterList]
  36. puts $filter
  37. return [list [parseFilter ($filter)] {*}[parseFilterList $filterList]]
  38. }
  39. }
  40.  
  41. proc ldap::getFilterListElement {filterListVar} {
  42. upvar 1 $filterListVar filterList
  43. set prev {}
  44. set depth 0
  45. set idx 0
  46. foreach cur [split $filterList ""] {
  47. switch -- $cur {
  48. ( { if {$prev ne "\\"} {incr depth} }
  49. ) { if {$prev ne "\\"} {incr depth -1} }
  50. }
  51. incr idx
  52. set prev $cur
  53. if {$depth == 0} {
  54. set item [string range $filterList 1 $idx-2]
  55. set filterList [string range $filterList $idx end]
  56. return $item
  57. }
  58. }
  59.  
  60. }
  61.  
  62. # and replace regexps by: set filterString [parseFilter $filterString]
  63.