home *** CD-ROM | disk | FTP | other *** search
/ PC World 2000 December / PCWorld_2000-12_cd.bin / Komunikace / Comanche / plugins / apache / apacheParser.tcl < prev    next >
Text File  |  2000-11-02  |  4KB  |  181 lines
  1.  
  2. class apacheParser {
  3.     inherit genericParser
  4.     
  5.     #Need to know which modules are enabled
  6.     
  7.     public variable moduleManager
  8.  
  9.     # Include root. Apache uses serverroot by default
  10.  
  11.     public variable includeroot
  12.  
  13.     constructor { dirDef confDoc  } {
  14.     genericParser::constructor $dirDef $confDoc
  15.     } {
  16.     }
  17.     method parseLine { data }
  18.     method beginSection {value class}
  19.     method endSection {}
  20.     method processDirective { text }
  21.     method loadValue {xuiObj text}
  22.     method isSpecialCase  
  23.     method processSpecialCase
  24. }
  25.  
  26.  
  27. body apacheParser::parseLine { data } {
  28.     set data [string trim $data]
  29.     if {[regexp "^ *#+" $data] || [regexp "^ *$" $data]} {
  30.     return
  31.     }
  32.     if [regexp "^ *</+.*>+$" $data] {
  33.     endSection
  34.     return
  35.     }
  36.     if [regexp "^ *<+.*>+$" $data] {
  37.     regexp {<([^ ]*) (.*)>}  $data  dummy class value
  38.     beginSection \
  39.         $value [string tolower $class]
  40.     } else {
  41.        if [catch {processDirective $data} kk] {
  42.       error "Error configuring directive $data\n$kk"
  43.        }
  44.     }                                     
  45. }
  46.  
  47. body apacheParser::beginSection { value class } {
  48.     $stack push $currentContainer
  49.     set currentContainer  \
  50.         [$xmlConf addContainer $currentContainer $value $class]
  51. }
  52.  
  53. body apacheParser::endSection {} {
  54.     set currentContainer [$stack pop]
  55. }
  56.  
  57.  
  58. body apacheParser::processDirective { text } {
  59.     set elements [::apacheparserutils::getElements $text ]
  60.     set dirName [string tolower [lindex $elements 0]]
  61.  
  62.     # Vary includeroot depending on the serverroot directive
  63.  
  64.     if [string match serverroot $dirName] {
  65.  
  66.     # join is necessary to handle spaces on Windows
  67.  
  68.     set includeroot [join [lindex $elements 1]]
  69.     }
  70.  
  71.     # include directives
  72.  
  73.     if [string match include $dirName] {
  74.  
  75.     # Need to handle full and relative paths
  76.  
  77.     set includeFile [join [lindex $elements 1]]
  78.     switch [file pathtype $includeFile] {
  79.         absolute {
  80.         
  81.         # Do nothing, we can open it
  82.  
  83.         $this parseFile $includeFile
  84.  
  85.         } relative { 
  86.         
  87.         # Ok, we need to prepend the conf directives dir
  88.         
  89.         set includeFile [file join $includeroot $includeFile]
  90.         if ![file exists $includeFile] {
  91.             puts "Include file $includeFile could not be processed. \
  92.                 Check that it exists"
  93.         } else {
  94.            $this parseFile $includeFile
  95.         }
  96.  
  97.         } volumerelative {
  98.  
  99.         # Um, unsure about what volume relative is.
  100.  
  101.         puts "Include path was volume relative"
  102.  
  103.         }
  104.     }
  105.     
  106.     }
  107.     
  108.  
  109.     # If module is not enabled, directive is treated as unknown
  110.     # (we can this way disable modules that could mistreat info)
  111.  
  112.     if ![$moduleManager isDirectiveEnabled $dirName] { 
  113.     set xuiUnknown [ xuiString ::#auto ]
  114.     $xuiUnknown setName $dirName
  115.     $xuiUnknown setValue $text
  116.     $xuiUnknown addClass unknownDirective
  117.     $xmlConf addDirective $xuiUnknown $currentContainer
  118.     return
  119.     }
  120.  
  121.     if [ isSpecialCase $dirName ] {
  122.     processSpecialCase $dirName $text
  123.     return
  124.     }
  125.     
  126.     # If error here is that the directive is unknown to us
  127.  
  128.     if ![catch {set xuiObj [apacheparserutils::getOrCreateIfNotExists \
  129.         $dirName $dirDefinition $xmlConf $currentContainer]} kk] {
  130.     switch [$xuiObj getXuiClass] {
  131.         string - choice - boolean - number {
  132.         ::apacheparserutils::loadValue $xuiObj [lindex $elements 1]
  133.         return
  134.         } structure {
  135.         error "Structure cannot be done (order issues) for [$xuiObj getName]"
  136.         }
  137.     }
  138.     } else {
  139.     set xuiUnknown [ xuiString ::#auto ]
  140.     $xuiUnknown setName $dirName
  141.     $xuiUnknown setValue $text
  142.     $xuiUnknown addClass unknownDirective
  143.     $xmlConf addDirective $xuiUnknown $currentContainer
  144.     return
  145.     }
  146. }
  147.  
  148.  
  149. body apacheParser::loadValue { dirObject value } {
  150.     switch [$dirObject getXuiClass] {
  151.     string - number {
  152.         $dirObject setValue [string trim $value]
  153.     } choice {
  154.         
  155.         $dirObject selectItem [string trim $value]
  156.     } boolean {
  157.         switch [string tolower [string trim $value]] {
  158.         on - yes - true - 1{
  159.             $dirObject setValue
  160.         }    off - false - no - 0{
  161.             $dirObject clearValue
  162.         }    default {
  163.             error "Boolean with value different from on/off"
  164.         }   
  165.         }
  166.     }
  167.     }
  168. }
  169.  
  170.  
  171. body apacheParser::isSpecialCase { dirName } {
  172.     return [info exists specialCaseMapping($dirName)]
  173. }
  174.  
  175. body apacheParser::processSpecialCase \
  176.     {dirName elements} {
  177.     $specialCaseMapping($dirName) $elements $this\
  178.         $dirDefinition $xmlConf $currentContainer 
  179.     
  180. }
  181.