home *** CD-ROM | disk | FTP | other *** search
/ PC World 2000 December / PCWorld_2000-12_cd.bin / Komunikace / Comanche / plugins / apache / apacheParserUtils.tcl < prev    next >
Encoding:
Text File  |  2000-11-02  |  3.2 KB  |  122 lines
  1.  
  2. namespace eval ::apacheparserutils:: {}
  3.  
  4. proc ::apacheparserutils::loadValue {dirObject value } {
  5.     switch [$dirObject getXuiClass] {
  6.     string - number {
  7.         if {[$dirObject doYouBelongTo directory] || \
  8.                [$dirObject doYouBelongTo file]} {
  9.         $dirObject setValue [string trim [string trim $value] \"]
  10.          } else {
  11.             $dirObject setValue [string trim $value]
  12.         }
  13.     } choice {
  14.         $dirObject selectItem [string trim $value]
  15.         } boolean {
  16.         switch [string tolower [string trim $value]] {
  17.         on - yes - true - 1 {
  18.            $dirObject setValue
  19.         }
  20.         off - false - no - 0 {
  21.             $dirObject clearValue
  22.         } default {
  23.             error "Boolean with value different from on/off"
  24.                 }
  25.         }
  26.     }
  27.     }
  28. }
  29.  
  30.  
  31. proc ::apacheparserutils::getOrCreateIfNotExists \
  32.     {directiveName dirDefinition xmlConf currentContainer} {
  33.     if [llength [set existingDir [$xmlConf getDirectiveByName \
  34.             $currentContainer $directiveName]]] {
  35.     if [$existingDir doYouBelongTo unknownDirective] {
  36.         error
  37.     }
  38.     set xuiObj $existingDir
  39.     } else {
  40.     if [llength [set xuiObj [[$dirDefinition getDirectiveByName \
  41.         $directiveName] clone]]] {
  42.         # If list, it has by construction the default. Since we are
  43.         # parsing, we delete that value (we are going to overwrite)
  44.         if ![string compare [$xuiObj getXuiClass] list] {
  45.             $xuiObj reset
  46.         }
  47.         $xmlConf addDirective $xuiObj $currentContainer
  48.     } else {
  49.         error
  50.     }
  51.     }
  52.     return $xuiObj
  53. }
  54.  
  55. proc ::apacheparserutils::loadInComponent { xuiObj name value } {
  56.      ::apacheparserutils::loadValue [$xuiObj getComponentByName $name] $value
  57. }
  58.  
  59. proc ::apacheparserutils::getElements {text} {
  60.     foreach {element rest} [ ::apacheparserutils::getElement $text] break
  61.     eval lappend result \{$element\}
  62.     while {[string length $rest]} {
  63.     foreach {element rest} [::apacheparserutils::getElement $rest] break
  64.     lappend result $element
  65.     }
  66.     
  67.     # 
  68.     
  69.     return $result
  70. }
  71.  
  72.  
  73. proc ::apacheparserutils::getElement { text } {
  74.     set text [string trim $text]
  75.     regexp {(("[^"]*")|([^ ]*)) ?} \
  76.         $text element
  77.         
  78.     # There was a problem with things like BrowserMatch, but the problem was
  79.     # not in getElements, but rather that the passed to special case is
  80.     # the text, not the elements! (change the naming in
  81.     # modules/*/specialCase.tcl )
  82.  
  83.     return [list [string trim $element] \
  84.         [string range $text [string length $element] end ]]
  85. }
  86.  
  87.  
  88.  
  89.  
  90.  
  91.  
  92.  
  93.  
  94. namespace eval ::apache1.3:: {} 
  95.  
  96.  
  97. proc ::apache1.3::parseStringList  {elements parser dirDef xmlConf
  98. currentContainer} {
  99.  
  100.     # Name is lowercase. Hope it works
  101.     
  102.     set xuiObj [apacheparserutils::getOrCreateIfNotExists \
  103.            [string tolower [lindex $elements 0]] \
  104.            $dirDef $xmlConf $currentContainer]
  105.     foreach one [lrange $elements 1 end] {
  106.         set child [$xuiObj newChild]
  107.     $xuiObj insertChild $child
  108.     $child setValue $one
  109.     }
  110. }
  111.                            
  112. proc ::apache1.3::dumpStringList { xuiObj } {
  113.     if ![llength [ $xuiObj getChildren ]] {return}
  114.     set result "[$xuiObj getName] "
  115.     foreach child [ $xuiObj getChildren ] {
  116.     append result "[$child getValue] "
  117.     }
  118.     append result "\n"
  119.     return $result
  120. }
  121.                          
  122.