home *** CD-ROM | disk | FTP | other *** search
/ PC World 2000 December / PCWorld_2000-12_cd.bin / Komunikace / Comanche / plugins / apache / modules / alias / specialCases.tcl < prev   
Encoding:
Text File  |  2000-11-02  |  4.3 KB  |  154 lines
  1. namespace eval ::apache1.3:: {}
  2.  
  3.  
  4. proc ::apache1.3::parseAlias {elements parser dirDef xmlConf currentContainer} {
  5.     
  6.     set name [string tolower [lindex $elements 0]]
  7.     set origin [lindex $elements 1]
  8.     set destination [lindex $elements 2]
  9.     
  10.     switch $name {
  11.     alias { 
  12.         set directiveName alias
  13.         set specific normal
  14.     }
  15.     aliasmatch {
  16.         set directiveName alias
  17.         set specific regexp
  18.     } scriptalias {
  19.         set directiveName scriptAlias
  20.         set specific normal
  21.     } scriptaliasmatch {
  22.         set directiveName scriptAlias
  23.         set specific regexp
  24.     } default {
  25.         error "unrecognized name $name"
  26.     }
  27.     }
  28.     set xuiObj [apacheparserutils::getOrCreateIfNotExists $directiveName \
  29.     $dirDef $xmlConf $currentContainer]    
  30.     set newElement [ $xuiObj newChild ]
  31.     $xuiObj insertChild $newElement
  32.     $newElement selectComponentByName $specific
  33.     set object [$newElement getComponentByName $specific]
  34.     [$object getComponentByName origin] setValue $origin
  35.     [$object getComponentByName destination] setValue $destination
  36. }
  37.  
  38. proc ::apache1.3::dumpAlias { xuiObj } {
  39.     set result {}
  40.     foreach child [ $xuiObj getChildren ] {
  41.     switch [$xuiObj getName] {
  42.         alias {
  43.         switch [[ set dir [$child getSelectedComponent]] getName] {
  44.             normal {
  45.             set directiveName alias
  46.             } regexp {
  47.             set directiveName aliasmatch
  48.             } default {
  49.             error "Error: alias"
  50.             }
  51.         }
  52.         }
  53.         scriptAlias {
  54.         switch [[ set dir [$child getSelectedComponent]] getName] {
  55.             normal {
  56.             set directiveName scriptalias
  57.             } regexp {
  58.             set directiveName scriptaliasmatch
  59.             } default {
  60.             error "Error: scriptalias"
  61.             }
  62.         }
  63.         } default {
  64.         error "Error: this is not supposed. \
  65.             Alias only alias and scriptalias"
  66.         }
  67.     }
  68.     set origin [[$dir getComponentByName origin] getValue]
  69.     set destination [[$dir getComponentByName destination] getValue]
  70.     if [regexp {\ } $destination] {
  71.         set destination "\"$destination\""
  72.     }
  73.     append result "$directiveName $origin $destination\n"
  74.     }
  75.     return $result
  76. }
  77.  
  78. proc ::apache1.3::parseRedirect \
  79.         {text parser dirDef xmlConf currentContainer} {
  80.     set elements ::apacheparserutils::getElements $text    
  81.     set xuiObj [apacheparserutils::getOrCreateIfNotExists redirect \
  82.             $dirDef $xmlConf $currentContainer]
  83.     set name [string tolower [lindex $elements 0]]
  84.     set newChild [$xuiObj newChild]
  85.     if {[llength $elements] == 4} {
  86.         set statusCode [lindex $elements 1]
  87.     switch $statusCode {
  88.         gone {
  89.             set statusCode 410
  90.         } temp {
  91.             set statusCode 302        
  92.         } permanent {
  93.             set statusCode 301        
  94.         } seeother {
  95.             set statusCode 303        
  96.         }
  97.     }
  98.     set elements [lrange $elements 2 end]
  99.     } else {
  100.         set statusCode 302
  101.     set elements [lrange $elements 1 end]
  102.     }
  103.     [$xuiObj getComponentByName statusCode] selectItemByName $statusCode
  104.     set origin [lindex $elements 0]
  105.     set destination [lindex $elements 1]
  106.     switch $name {
  107.     redirect { 
  108.         set directiveName alias
  109.         set specific normal
  110.     }
  111.     redirectmatch {
  112.         set directiveName alias
  113.         set specific regexp
  114.     }
  115.     }
  116.     switch $
  117.     [$newChild getComponentByName redirect] selectComponentByName $specific
  118.     set object [[$newChild getComponentByName redirect] \
  119.         getComponentByName $specific]
  120.     [$object getComponentByName origin] setValue $origin
  121.     [$object getComponentByName destination] setValue $destination
  122.     $xuiObj insertChild $newChild
  123.  
  124. }
  125.  
  126. proc ::apache1.3::dumpRedirect { xuiObj } {
  127.     set result {}
  128.     foreach child [ $xuiObj getChildren ] {
  129.     switch [[ set dir [[$child getComponentByName redirect] \
  130.         getSelectedComponent]] getName] {
  131.         normal {
  132.         set directiveName redirect
  133.         } regexp {
  134.         set directiveName redirectmatch
  135.         } default {
  136.         error "Error: redirect"
  137.         }
  138.     }
  139.     set origin [[$dir getComponentByName origin] getValue]
  140.         set code [[$child getComponentByName statusCode] getSelected]
  141.     switch $code {
  142.         default { 
  143.             set destination {} 
  144.         } 3* {
  145.             set destination \
  146.             [[$dir getComponentByName destination] getValue]
  147.         }
  148.     }
  149.     append result "$directiveName $code $origin $destination\n"
  150.     }
  151.     return $result
  152. }
  153.  
  154.