source: tol/tolsh/tolsh.vfs/lib/app-tolsh/tolsh.tcl @ 74a218d

1941-docker-image-to-testdevel
Last change on this file since 74a218d was 74a218d, checked in by Jorge Pérez <josp.jorge@…>, 17 years ago

refs #817 : in order to deal with multiple versions of tolsh "package require Toltcl" must be '-exact'

git-svn-id: ​https://www.tol-project.org/svn/tolp/trunk@1831 be4846ae-f051-483a-831f-b64e7d08527f
  • Property mode set to 100755
File size: 12.7 KB
Line 
1#!/usr/bin/env tclsh
2
3###############################################################################
4#
5# tolsh.tcl --
6#
7###############################################################################
8
9package provide tolsh 1.0
10
11###############################################################################
12#
13#  Tol_HciWriter --
14#
15#  This file will be invoked by TOL if HCI output is enabled
16#
17###############################################################################
18proc Tol_HciWriter { msg } {
19  puts [string trim $msg]
20}
21
22###############################################################################
23#
24#  namespace tolsh -- encapsulate tolsh functionality
25#
26###############################################################################
27namespace eval ::tolsh {
28  variable options
29
30  # By default load initLibrary
31  #
32  set options(lang)    0
33  set options(initlib) 1
34  set options(compile) ""
35  set options(vmode)   ""
36  set options(out,enabled) no
37  set options(runmode) ""
38}
39
40###############################################################################
41#
42#  getoptions -- process the command line
43#
44#  The command line accepted by tolsh is:
45#
46#    -i       --> do not include initLibrary
47#    -c"..."  --> compile a tol expression
48#    -c "..." --> compile a tol expression
49#    -v?A?    --> enable all output
50#    -vE      --> enable error output
51#    -vS      --> enable system output
52#    -vU      --> enable user output
53#    -vT      --> enable trace output
54#    -m?A?    --> disable all output
55#    -mE      --> disable error output
56#    -mS      --> disable system output
57#    -mU      --> disable user output
58#    -mT      --> disable trace output
59#    -d       --> start in dialog mode
60#    -e?n?    --> use english language
61#    -s?p?    --> use spanish language
62#    -server [port] --> start tol as a server tolsvc.<pid>.log will be the log
63#             [port] is the port number where the serve will be listening.
64#
65#  Any other value will be considered a file to compile
66#
67#  Arguments:
68#
69###############################################################################
70proc ::tolsh::getoptions { cmdline } {
71  variable options
72
73  logtmp "entering ::tolsh::getoptions $cmdline"
74
75  # cmdline could be a bad list so the next sentence could fail.
76  # try to test it in front of bugs situations.
77  set num [llength $cmdline]
78  set delayed_msg ""
79  set i 0
80  while {$i < $num} {
81    set item [lindex $cmdline $i]
82    if {[string index $item 0] eq "-"} {
83      set opt [string range $item 1 end]
84      if {$opt eq "e" || $opt eq "en"} {
85        set $options(lang) 0
86      } elseif {$opt eq "s" || $opt eq "sp"} {
87        set $options(lang) 1
88      } elseif {$opt eq "i"} {
89        # initLibrary should not be loaded
90        #
91        set options(initlib) 0
92      } elseif {[string index $opt 0] eq "c"} {
93        if {[string length $opt]>1} {
94          # The tol expression is part of the option
95          #
96          set expr [string range $opt 1 end]
97        } else {
98          # Next argument is the expression to compile
99          #
100          incr i
101          set expr [lindex $cmdline $i]
102        }
103        # Put expr in the list of "things" to compile
104        #
105        lappend options(compile) [list expr $expr]
106      } elseif {[string index $opt 0] eq "v"} {
107        if {[regexp {^[A|S|U|T|E|W]*$} [string range $opt 1 end] mode]} {
108          if {$mode eq ""} {
109            set mode A
110          }
111          if {[regexp {[A|S]} $mode]} {
112            set options(out,enabled) yes
113          }
114          append options(vmode) "v$mode "
115        } else {
116          append delayed_msg "\nignoring unknown verbose mode: '$opt'"
117        }
118      } elseif {[string index $opt 0] eq "m"} {
119        if {[regexp {^[A|S|U|T|E|W]*$} [string range $opt 1 end] mode]} {
120          if {$mode eq ""} {
121            set mode A
122          }
123          if {[regexp {[A|S]} $mode]} {
124            set options(out,enabled) no
125          }
126          append options(vmode) "m$mode "
127        } else {
128          append delayed_msg "\nignoring unknown mute mode: '$opt'"
129        }
130      } elseif {$opt eq "d"}  {
131        if {$options(runmode) ne "" && $options(runmode) ne "interactive"} {
132          puts "Replacing previous run mode '$options(runmode)' with 'interactive'"
133        }
134        set options(runmode) "interactive"
135      } elseif {$opt eq "server"} {
136        # check if next argument is the port number
137        set port [lindex $cmdline [expr {$i+1}]]
138        if {[string is integer $port]} {
139          # $i+1 is an integer, should be considered as a port number
140          incr i
141          if {$port <= 0} {
142            puts "Could not start as a server: invalid port number '${port}'"
143            exit
144          }
145          if {$options(runmode) ne "" && $options(runmode) ne "server"} {
146            puts "Replacing previous run mode '$options(runmode)' with 'server'"
147          }
148          set options(runmode) "server"
149          set options(server,port) $port
150        } else {
151          puts "Could not start as a server: invalid port number '${port}'"
152          exit
153        }
154      } else {
155        append delayed_msg "\nignoring unknown option: '$item'"
156      }
157    } else {
158      # Consider this option as a tol file to compile.
159      #
160      if {![file exists $item] || ![file readable $item]} {
161        puts "file $item does not exist or is not readable"
162      } else {
163        lappend options(compile) [list file $item]
164      }
165    }
166    incr i
167  }
168  if {$delayed_msg ne ""} {
169    std $delayed_msg
170  }
171}
172
173###############################################################################
174#
175#  something_to_compile -- tell us if there is something to do
176#
177#  Depending on the command line processing some tol expression or
178#  files needs to be compiled. All this is stored in options(compile)
179#
180#  Return:
181#
182#    true value if there is something to compile in $options(compile)
183#    false if $options(compile) is empty
184#
185###############################################################################
186proc ::tolsh::something_to_compile { } {
187  variable options
188
189  llength $options(compile)
190}
191
192###############################################################################
193#
194#  show_usage -- show how to invoke tolsh
195#
196#  This proc print into stdout a message that list the valid options accepted.
197#
198###############################################################################
199proc ::tolsh::show_usage { } {
200  puts "[get_app_name] \[options] filename ...\noptions:"
201  puts {
202    -i file  --> include a file but not initLibrary
203    -c"..."  --> compile a tol expression
204    -c "..." --> compile a tol expression
205    -v?A?    --> enable all output
206    -vE      --> enable error output
207    -vS      --> enable standard output
208    -vU      --> enable user output
209    -vT      --> enable trace output
210    -m?A?    --> disable all output
211    -mE      --> disable error output
212    -mS      --> disable standard output
213    -mU      --> disable user output
214    -mT      --> disable trace output
215    -d       --> start in dialog mode
216    -e?n?    --> use english language
217    -s?p?    --> use spanish language
218   -server [port] --> start tol as a server tolsvc.<pid>.log will be the log
219           [port] is the port number where the serve will be listening.
220 
221  Multiple verbose mode is accepted in one option, for instance,
222
223    -vUE
224  }
225}
226
227###############################################################################
228#
229#  getArgv0 -- return the name of the app
230#
231###############################################################################
232proc ::tolsh::get_app_name {} {
233    global argv0
234
235    set name [file tail $argv0]
236    return [file rootname $name]
237}
238
239###############################################################################
240#
241#  append_message -- save a message
242#
243###############################################################################
244proc ::tolsh::std { msg } {
245  variable options
246
247  if {$options(out,enabled)} {
248    puts $msg
249  }
250}
251
252proc ::tolsh::setup_pkg { pkg } {
253  if {[lsearch [package names] $pkg]==-1} {
254    if {[namespace exist ::starkit]} {
255      set bindir [file dir $starkit::topdir]
256      set libdir [file join $bindir .. lib]
257      set pkg_dirs [glob -nocomplain -dir $libdir ${pkg}*]
258      if {[llength $pkg_dirs]} {
259        lappend ::auto_path [file normalize $libdir]
260      } else {
261        set tclsh [auto_execok tclsh]
262        if {![catch {
263          exec echo puts {$::auto_path} | $tclsh
264        } ext_auto_path]} {
265          foreach p $ext_auto_path {
266            if {[lsearch $::auto_path $p]==-1} {
267              lappend ::auto_path $p
268            }
269          }
270        }
271      }
272      tclPkgUnknown ${pkg}+1 ""
273    } else {
274      set pkg_dev_dir [file normalize [file join .. $pkg]]
275      if {[file exists $pkg_dev_dir] && [file isdir $pkg_dev_dir]} {
276        lappend ::auto_path $pkg_dev_dir
277      }
278    }
279  }
280}
281
282###############################################################################
283#
284#  setup_autopath --
285#
286#  Set auto_path in order to find correctly the following packages:
287#
288#    - toltcl
289#    - rmtps_client
290#
291###############################################################################
292proc ::tolsh::setup_autopath { } {
293  logtmp "entering ::tolsh::setup_autopath"
294
295  setup_pkg toltcl
296  setup_pkg tolcomm
297  setup_pkg tlogger
298
299  logtmp "auto_path = $::auto_path"
300  logtmp "leaving ::tolsh::setup_autopath" 
301}
302
303###############################################################################
304#
305#  main -- entry point for tolsh application
306#
307###############################################################################
308proc ::tolsh::run { cmdline } {
309  variable options
310
311  logtmp "user : [ exec whoami ]"
312  logtmp "entering run with cmdline = $cmdline"
313  # Process command line options
314  #
315  getoptions $cmdline
316  logtmp "options(compile): $options(compile)"
317  logtmp "options(runmode): $options(runmode)"
318  if {![something_to_compile] && ($options(runmode) eq "")} {
319    show_usage
320    return
321  }
322 
323  logtmp "pase getoptions"
324
325  # Ensure Toltcl is found
326  #
327  setup_autopath
328
329  # Load Toltcl (+tol)
330  #
331  package require -exact Toltcl 2.0.1
332
333  logtmp "after require Toltcl"
334
335  tol::initkernel $options(lang) $options(vmode)
336
337  # Load initLibrary if required
338  #
339  if {$options(initlib)} {
340    tol::initlibrary
341  }
342
343  set appdata [string trim \
344               [lindex [::tol::info var [list Text TolAppDataPath]] 2] \"]
345
346  logtmp "appdata = $appdata"
347
348  set tolcomm_dir [file join $appdata tolcomm]
349  file mkdir $tolcomm_dir
350
351  # load rmtps_client
352  #
353  if {[catch {package require rmtps_client} msg]} {
354    std "could not load rmtps_client: $msg"
355  } else {
356    ::rmtps_client::init [file join $tolcomm_dir "rmtps_client.log"]
357    if {[catch rmtps_client::define_TOLAPI msg]} {
358      std "could not load tol code for rmtps_client: $msg"
359    }
360  }
361 
362  # load tolclient
363  #
364  if {[catch {package require tolclient} msg]} {
365    std "could not load tolclient: $msg"
366  } else {
367    ::tolclient::init [file join $tolcomm_dir "tolclient.log"]
368    if {[catch ::tolclient::define_TOLAPI msg]} {
369      std "could not load tol code for rmtps_client: $msg"
370    }
371  }
372
373  # Compile expression and tol file provided in the command line
374  #
375  foreach item $options(compile) {
376    if {[lindex $item 0] eq "expr"} {
377      tol::console eval [lindex $item 1]
378    } elseif {[lindex $item 0] eq "file"} {
379      tol::include [lindex $item 1]
380    }
381  }
382 
383  if {$options(runmode) eq "interactive"} {
384    # assign our event handler for stdin
385    fileevent stdin readable ::tolsh::stdin_handler
386    # send a startup message and initial prompt
387    puts stdout "TOL interactive shell activated..."
388    console_prompt
389    # enter the tcl event loop
390    vwait __forever__
391  } elseif {$options(runmode) eq "server"} {
392    package require tolserver
393    tolserver::start -port $options(server,port) \
394        -logfile [file join $tolcomm_dir "tolserver.log"]
395    vwait __forever__
396  }
397}
398
399proc ::tolsh::console_cmd { cmd } {
400  if {$cmd eq "END" || $cmd eq "QUIT" || $cmd eq "EXIT"} {
401    exit
402  } else {
403    puts stdout "unknown console command: '$cmd'"
404  }
405}
406
407proc ::tolsh::console_eval { tol_stms } {
408  set con_objs0 [tol::console stack list]
409  tol::console eval $tol_stms
410  set con_objs1 [tol::console stack list]
411  if {[llength $con_objs1]>[llength $con_objs0]} {
412    puts stdout [lindex [lindex $con_objs1 end] 2]
413  }
414}
415
416proc ::tolsh::console_prompt {} {
417    puts -nonewline stdout \
418        "[clock format [clock seconds] -format %H:%M:%S] TOL> "
419    flush stdout
420}
421
422proc ::tolsh::stdin_handler {} {
423  # get the data from stdin
424  #
425  gets stdin data
426  if {[string index $data 0] eq "\\"} {
427    console_cmd [string toupper [string range $data 1 end]]
428  } else {
429    console_eval $data
430  }
431  # return a new pseudo-prompt
432  console_prompt
433  return
434}
435
436proc logtmp { msg } {
437  return
438  set user [ exec whoami ]
439  set fd [ open "/tmp/tolsh.${user}.log" a ]
440  puts $fd $msg
441  flush $fd
442  close $fd
443}
444
445::tolsh::run $argv
Note: See TracBrowser for help on using the repository browser.