home *** CD-ROM | disk | FTP | other *** search
/ PC World 2000 December / PCWorld_2000-12_cd.bin / Komunikace / Comanche / plugins / samba / lib / sambaParser.tcl < prev    next >
Encoding:
Text File  |  2000-11-02  |  3.6 KB  |  168 lines
  1.  
  2. class sambaParser {
  3.     inherit genericParser
  4.  
  5.     constructor { dirDef confDoc  } {
  6.     genericParser::constructor $dirDef $confDoc
  7.     } {
  8.     }
  9.  
  10.     method parseLine { text }
  11.     
  12.     method beginSection 
  13.  
  14.     
  15.     method processDirective
  16.     method processStructure
  17.     method loadValue
  18.     method getElements
  19.     method getElement
  20.     method getDirectiveValue
  21.     method getDirectiveName
  22.     method isSpecialCase  
  23.     method processSpecialCase
  24. }
  25.  
  26.  
  27. body sambaParser::parseLine { data } {
  28.     
  29.     set data [string trim $data]
  30.     if {[regexp "^ *;+" $data] ||\
  31.         [regexp "^ *#+" $data] ||[regexp "^ *$" $data]} {
  32.  
  33.        return
  34.     }
  35.     
  36.     
  37.     if [regexp {^\[(.*)\]} $data match name] {
  38.  
  39.     beginSection $name share
  40.     } else {
  41.  
  42.  
  43.     processDirective $data
  44.     }                                     
  45. }
  46.  
  47.  
  48. body sambaParser::beginSection { value class } {
  49.     set currentContainer  \
  50.         [$xmlConf addContainer $rootContainer $value $class]
  51. }
  52.  
  53.  
  54.  
  55. body sambaParser::processDirective { text } {
  56.  
  57.  
  58.     set dirName [string tolower [ getDirectiveName $text ]]
  59.  
  60.     if [ isSpecialCase $dirName ] {
  61.  
  62.  
  63.     processSpecialCase $dirName $text
  64.     return
  65.     }
  66.  
  67.  
  68.  
  69.     if [llength [set dirObject \
  70.         [$dirDefinition getDirectiveByName $dirName]]] {
  71.     
  72.  
  73.     switch [$dirObject getXuiClass] {
  74.         string - choice - boolean - number {
  75.             if [llength [set existingDir \
  76.                 [$xmlConf getDirectiveByName \
  77.             $currentContainer $dirName]]] {
  78.             set xuiObj $existingDir
  79.             } else {
  80.         set xuiObj [$dirObject clone]
  81.         $xmlConf addDirective $xuiObj $currentContainer
  82.         }
  83.         
  84.         set value [getDirectiveValue $text]
  85.         
  86.         loadValue $xuiObj $value
  87.         return
  88.         } structure {
  89.         set value {}
  90.         regexp {([^ ]*) (.*)} $text dummy name value
  91.         processStructure $xuiObj $value
  92.         return
  93.         }
  94.     }
  95.     } else {
  96.  
  97.           set xuiUnknown [ xuiString ::#auto ]
  98.       $xuiUnknown setName $dirName
  99.       $xuiUnknown setValue $text
  100.       $xuiUnknown addClass unknownDirective
  101.       $xmlConf addDirective $xuiUnknown $currentContainer
  102.       return
  103.     }
  104.     error "Not recognized, not a special case $text"
  105. }
  106.  
  107.  
  108. body sambaParser::processStructure { xuiObj text } {
  109.     set components [$xuiObj components]
  110.     
  111.     set structureComponents [ $this getElements $text]
  112.     set idx 0
  113.     foreach component $components {
  114.     switch [$component getXuiClass] {
  115.         string - choice - boolean - number {
  116.         loadValue $component [lindex $structureComponents $idx]
  117.         } default {
  118.         error "Component in a structure of unrecognized class"
  119.         }
  120.     }
  121.     incr idx
  122.     }
  123. }                         
  124.  
  125.  
  126.  
  127.  
  128.  
  129. body sambaParser::getDirectiveName { text } {
  130.     return [lindex [::sambautils::getElements $text] 0]
  131.  
  132. }
  133. body sambaParser::getDirectiveValue { text } {
  134.     return [lindex [::sambautils::getElements $text] 1]
  135. }
  136.  
  137. body sambaParser::isSpecialCase { dirName } {
  138.     return [info exists specialCaseMapping($dirName)]
  139. }
  140.  
  141. body sambaParser::processSpecialCase { dirName text } {
  142.     $specialCaseMapping($dirName) parse $text $this\
  143.     $dirDefinition $xmlConf $currentContainer 
  144.  
  145. }
  146. body sambaParser::loadValue { dirObject value } {
  147.     switch [$dirObject getXuiClass] {
  148.     string - number {
  149.         $dirObject setValue [string trim $value]
  150.     } choice {
  151.         $dirObject selectItem [string trim $value]
  152.     } boolean {
  153.         switch [string tolower [string trim $value]] {
  154.         on - yes - true - 1 {
  155.             $dirObject setValue
  156.         }    off - false - no - 0 {
  157.             $dirObject clearValue
  158.         }    default {
  159.             error "Boolean with value different from on/off: [$dirObject getName] $value"
  160.         }   
  161.         }
  162.     }
  163.     }
  164. }
  165.  
  166.  
  167.  
  168.