Changeset 542c12b in tol for tolsh/tolsh.vfs/lib/app-tolsh/tolsh.tcl

Timestamp:

Mar 11, 2010, 11:40:22 AM (17 years ago)

Author:

Liván Ramírez Dorta <livanr68@…>

Branches:

1941-docker-image-to-test, devel, master

Children:

2ef94a4

Parents:

a4e3c41

Message:

refs#873: Improve TolServer process structure

git-svn-id: ​https://www.tol-project.org/svn/tolp/trunk@2052 be4846ae-f051-483a-831f-b64e7d08527f

File:

• tolsh/tolsh.vfs/lib/app-tolsh/tolsh.tcl (modified) (4 diffs)

tolsh/tolsh.vfs/lib/app-tolsh/tolsh.tcl

@@ -157 +157 @@
           exit
         }
+      } elseif {$opt eq "slave"} {
+        # the next argument is the port number
+        set options(server,port) [lindex $cmdline [expr {$i+1}]]
+        incr i
+        if {$options(runmode) ne "" && $options(runmode) ne "slave"} {
+          puts "Replacing previous run mode '$options(runmode)' with 'slave'"
+        }
+        set options(runmode) "slave"
+      } elseif {$opt eq "shared"} {
+        if {$options(runmode) ne "" && $options(runmode) ne "shared"} {
+          puts "Replacing previous run mode '$options(runmode)' with 'shared'"
+        }
+        set options(runmode) "shared"
       } else {
         append delayed_msg "\nignoring unknown option: '$item'"
@@ -302 +315 @@
   setup_pkg tolcomm
   setup_pkg tlogger
+  setup_pkg tequila
+  setup_pkg tequilas
 
   logtmp "auto_path = $::auto_path"
   logtmp "leaving ::tolsh::setup_autopath"  
+}
+
+proc GetHomeDir { } {
+  global env 
+  # Check if we're using windows 
+  if { $::tcl_platform(platform) eq "windows" } {
+    package require registry 1.0
+    set key1 {HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Explorer\User Shell Folders}
+    set key2 {Personal}
+    set env_home [ registry get $key1 $key2 ]
+    if {[string match %USERPROFILE%* $env_home]} {
+      set env_home [string replace $env_home 0 12 $env(USERPROFILE)]
+    } 
+  } else {
+    set env_home $env(HOME)
+  }
+  return $env_home
 }
 
@@ -333 +365 @@
   setup_autopath
 
-  # Load Toltcl (+tol)
-  #
-  package require -exact Toltcl 2.0.1
-  tol::initkernel $options(lang) $options(vmode)
-
-  # Load initLibrary if required
-  #
-  if {$options(initlib)} {
-    tol::initlibrary
-  }
-
-  set appdata [string trim \
+  # Load Toltcl (+tol) and initLibrary if required
+  #
+  if {$options(runmode) != "server" && $options(runmode) != "shared"} {
+    package require -exact Toltcl 2.0.1
+    tol::initkernel $options(lang) $options(vmode)
+
+    if {$options(initlib)} {
+      tol::initlibrary
+    }
+
+    set appdata [string trim \
                [lindex [::tol::info var [list Text TolAppDataPath]] 2] \"]
-
-  logtmp "appdata = $appdata"
-
-  set tolcomm_dir [file join $appdata tolcomm] 
+    logtmp "appdata = $appdata"
+  }
+
+  set tolcomm_dir [file join [GetHomeDir] tolcomm] 
   file mkdir $tolcomm_dir
 
-  # load rmtps_client
-  #
-  if {[catch {package require rmtps_client} msg]} {
-    std "could not load rmtps_client: $msg"
-  } else {
-    ::rmtps_client::init [file join $tolcomm_dir "rmtps_client.log"]
-    if {[catch rmtps_client::define_TOLAPI msg]} {
-      std "could not load tol code for rmtps_client: $msg"
+  # load rmtps_client and tolclient if required
+  #
+  if {$options(runmode) != "server" && $options(runmode) != "shared"} {
+  
+    if {[catch {package require rmtps_client} msg]} {
+      std "could not load rmtps_client: $msg"
+    } else {
+      ::rmtps_client::init [file join $tolcomm_dir "rmtps_client.log"]
+      if {[catch rmtps_client::define_TOLAPI msg]} {
+        std "could not load tol code for rmtps_client: $msg"
+      }
     }
-  }
   
-  # load tolclient
-  #
-  if {[catch {package require tolclient} msg]} {
-    std "could not load tolclient: $msg"
-  } else {
-    ::tolclient::init [file join $tolcomm_dir "tolclient.log"]
-    if {[catch ::tolclient::define_TOLAPI msg]} {
-      std "could not load tol code for rmtps_client: $msg"
+    if {[catch {package require tolclient} msg]} {
+      std "could not load tolclient: $msg"
+    } else {
+      ::tolclient::init [file join $tolcomm_dir "tolclient.log"]
+      if {[catch ::tolclient::define_TOLAPI msg]} {
+        std "could not load tol code for rmtps_client: $msg"
+      }
     }
-  }
-
-  # Compile expression and tol file provided in the command line
-  #
-  foreach item $options(compile) {
-    if {[lindex $item 0] eq "expr"} {
-      tol::console eval [lindex $item 1]
-    } elseif {[lindex $item 0] eq "file"} {
-      tol::include [lindex $item 1]
+    
+  }
+
+  # Compile expression and tol file provided in the command line if required
+  #
+  if {$options(runmode) != "server" && $options(runmode) != "shared" \
+                                    && $options(runmode) != "slave" } {
+
+    foreach item $options(compile) {
+      if {[lindex $item 0] eq "expr"} {
+        tol::console eval [lindex $item 1]
+      } elseif {[lindex $item 0] eq "file"} {
+        tol::include [lindex $item 1]
+      }
     }
+
   }
   
@@ -392 +430 @@
     # enter the tcl event loop
     vwait __forever__
+    
   } elseif {$options(runmode) eq "server"} {
-    package require tolserver
-    tolserver::start -port $options(server,port) \
-        -logfile [file join $tolcomm_dir "tolserver.log"]
-    vwait __forever__
-  }
-}
+    puts "runmode=server"
+    run_as_server $tolcomm_dir
+    
+  } elseif {$options(runmode) eq "shared"} {
+    puts "runmode=shared"
+    run_as_shared    
+  
+  } elseif {$options(runmode) eq "slave"} {
+    puts "runmode=slave"
+    run_as_slave $tolcomm_dir   
+  }
+}
+
+proc ::tolsh::run_as_server {tolcomm_dir} {
+  variable options
+  package require tolserver
+
+  clone
+  tolserver::start -port $options(server,port) \
+    -logfile [file join $tolcomm_dir "tolserver.log"] \
+    -compile $options(compile)
+  vwait __forever__
+}   
+
+proc ::tolsh::clone {} {
+  variable options
+
+  puts "::tolsh::clone"
+  set tolsh [info nameofexecutable]
+  puts "exec shared"
+  exec $tolsh -shared &
+  after 5000            ;# wait for data sharing are created by 'shared'
+  puts "exec slave"
+  exec $tolsh -slave $options(server,port) &
+}
+
+proc ::tolsh::run_as_shared {} {
+  package require tolshared
+
+  tolshared::start
+}   
+
+proc ::tolsh::run_as_slave {tolcomm_dir} {
+  variable options
+  package require tolslave
+
+  tolslave::start -port $options(server,port) \
+    -logfile [file join $tolcomm_dir "tolslave.log"]
+  vwait __forever__
+}   
 
 proc ::tolsh::console_cmd { cmd } {