PC World 2000 December/PCWorld_2000-12_cd.bin/Komunikace/Comanche/plugins/apache/prettyDumper.tcl

Text File | 2000-11-02 | 5.6 KB | 255 lines

# apachePrettyDumper --
#   Dumps the XML configuration to httpd.conf, trying its best to
#   preserve coments, etc
# Output algorithm
#    > Read input
#           - If comment, output
#    xmlDirectives List with all the xmlDirectives not yet dumped.
#    httpdDirectives List with all http directives
#    already processed in
#    this section.
#    Case Section {
#    Check if section with that name exists.
#    If not, just skip it
#    If only one,
#    process using new section
#    If more than one may be a serverName problem (same IP,!=servername)
#    Check if serverName is the same if it is dump it
#    if not just
#    ignore
#    }
#    Case directive {
#    If already for this container, do
#    nothing (httpdDirectives)
#    If !specialCase and !notExists
#    check if unknown with the same name, dump all unknown
#    with same name, remove from xmlDirectives
#    add to httpdDirectives
#    }

class apachePrettyDumper {
   variable specialCaseMapping
   variable outputText {}
   variable inputText {}
   variable currentText {}
   variable sectionStack
   constructor {} {
       set sectionStack [stack #auto]
   }
   method init
   method dump
   method getLine
   method addLine
   method beginSection
   method endSection
   method processDirective
   method setSpecialCase
   method endOfText


}
body apachePrettyDumper::init { text } {

    # Take into account here line continuation

    set inputText [split $text \n]
    set currentText $inputText
    #puts "$inputText"
}

body apachePrettyDumper::endOfText {} {
   return [expr ![llength $currentText]]
}

body apachePrettyDumper::dump {xmlConf} {
    set result {}
    while {![endOfText]} {

    set line [getLine]
    puts $line

    # Leave comments and blank lines as-is

    set data [string trim $line]
    if {[regexp "^#+" $data] || ![string length $data]} {
        addLine $line
    } elseif [regexp "^ *</+.*>+$" $data] {
        endSection
    } elseif [regexp "^ *<+.*>+$" $data] {
        regexp {<([^ ]*) (.*)>}  $data dummy class value
    beginSection \
    [string tolower $value] [string tolower $class]
    } else {
        processDirective $data
    }
    }
    puts kk
    puts $outputText
}

body apachePrettyDumper::getLine {} {

   # add \n because removed on original split

   set result [lindex $currentText 0]
   set currentText [lrange $currentText 1 end]
   return $result
}

body apachePrettyDumper::beginSection {args} {

}

body apachePrettyDumper::endSection {args} {

}

body apachePrettyDumper::processDirective {data} {
   addLine $data
}

body apachePrettyDumper::addLine {data} {
   append outputText $data
   append outputText \n
}

body apachePrettyDumper::setSpecialCase { procedure args } {
    foreach directive $args {
    set specialCaseMapping([string tolower $directive]) \
    $procedure
    }
}











































set comment {{
    variable specialCaseMapping
    constructor {} {
    array set specialParseCaseMapping  {}
    array set specialCaseMapping  {}
    }
    method setSpecialCase { procedure args }
    method isSpecialCase { dirName }
    method processContainer { xmlConf container }
    method dump { xmlConf }
    method dumpContainer { xmlConf container }
}

body apacheDumper::isSpecialCase { dirName } {
    return [info exists specialCaseMapping($dirName)]
}

body apacheDumper::dump { httpdFileText xmlConfDoc } {
   set result [ dumpContainer $xmlConfDoc \
       [set rootC [$xmlConfDoc getRootContainer]]]
   foreach container [$xmlConfDoc getContainers $rootC] {
    append result [ processContainer $xmlConfDoc $container]
   }
   return $result
}

body apacheDumper::processContainer { xmlConfDoc container } {
    set result {}
    append result "<[$container getClasses] [$container getName]>\n"
    append result [ dumpContainer $xmlConfDoc $container ]
    foreach childContainer [$xmlConfDoc getContainers $container] {
    append result [ processContainer $xmlConfDoc $childContainer]
    }
    append result "</[$container getClasses]>\n"
    return $result
}


body apacheDumper::dumpContainer { xmlConfDoc container } {
    set result {}
    foreach directive [$xmlConfDoc getDirectives $container] {
    set dirName [string tolower [$directive getName]]
    if [isSpecialCase $dirName] {
        append result "[$specialCaseMapping($dirName) $directive]\n"
    } else {
        if [$directive doYouBelongTo unknownDirective] {
            append result "[$directive getValue]\n"
        } else {
        switch [$directive getXuiClass] {
        string - number  {
            set value [$directive getValue]
            if [string compare $value [$directive getDefault]] {
                    set value [$directive getText]
                if {[$directive doYouBelongTo file] || \
                        [$directive doYouBelongTo directory] } {
                    if [regexp {\ } $value] {
                        set value "\"$value\""
                    }
                }
                append result "$dirName $value\n"
            }
        } boolean {
            set value [$directive getValue]
            if [string compare $value [$directive getDefault]] {
                switch $value {
                0 {
                    append result "$dirName off\n"
                } 1 {
                    append result "$dirName on\n"
                }
            }
            }
        } choice {
            append result \
                   "$dirName [$directive getSelected]\n"
        } default {
           error "No special case and not recognized in dumping\
                   [$directive getXuiClass] [$directive getName]"
        }
        }
       }
    }
    }
    return $result
}




}