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

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

refs #817 : new option -tolversion indicate the version of tol required

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