TclCommand.cc

Go to the documentation of this file.
00001 /*
00002  *    Copyright 2004-2006 Intel Corporation
00003  * 
00004  *    Licensed under the Apache License, Version 2.0 (the "License");
00005  *    you may not use this file except in compliance with the License.
00006  *    You may obtain a copy of the License at
00007  * 
00008  *        http://www.apache.org/licenses/LICENSE-2.0
00009  * 
00010  *    Unless required by applicable law or agreed to in writing, software
00011  *    distributed under the License is distributed on an "AS IS" BASIS,
00012  *    WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
00013  *    See the License for the specific language governing permissions and
00014  *    limitations under the License.
00015  */
00016 
00017 #include "config.h"
00018 
00019 #include "TclCommand.h"
00020 #include "HelpCommand.h"
00021 #include "DebugCommand.h"
00022 #include "LogCommand.h"
00023 
00024 #include "debug/DebugUtils.h"
00025 #include "io/NetUtils.h"
00026 #include "thread/SpinLock.h"
00027 #include "util/StringBuffer.h"
00028 #include "util/InitSequencer.h"
00029 
00030 extern "C" int Tclreadline_Init(Tcl_Interp* interp);
00031 
00032 namespace oasys {
00033 
00034 /******************************************************************************
00035  *
00036  * TclCommandInterp
00037  *
00038  *****************************************************************************/
00039 // static variables
00040 TclCommandInterp* TclCommandInterp::instance_;
00041 TclCommandList*   TclCommandInterp::auto_reg_ = NULL;
00042 
00043 #include "command-init-tcl.c"
00044 
00045 TclCommandInterp::TclCommandInterp()
00046     : Logger("TclCommandInterp", "/command")
00047 {}
00048 
00049 int
00050 TclCommandInterp::do_init(char* argv0, bool no_default_cmds)
00051 {
00052     interp_ = Tcl_CreateInterp();
00053     lock_   = new SpinLock();
00054     Tcl_Preserve(interp_);
00055 
00056     // for some reason, this needs to be called to set up the various
00057     // locale strings and get things like the "ascii" encoding defined
00058     // for a file channel
00059     Tcl_FindExecutable(argv0);
00060     
00061     // run Tcl_Init to set up the local tcl package path, but don't
00062     // depend on it succeeding in case there's a strange tcl
00063     // installation
00064     if (Tcl_Init(interp_) != TCL_OK) {
00065         StringBuffer err("initialization problem calling Tcl_Init: %s\n"
00066                          "(this is not a fatal error, continuing initialization...)\n\n",
00067                          interp_->result);
00068         log_multiline(LOG_WARN, err.c_str());
00069     }
00070 
00071     // do auto registration of commands (if any)
00072     if (auto_reg_) {
00073         ASSERT(auto_reg_); 
00074         while (!auto_reg_->empty()) {
00075             TclCommand* m = auto_reg_->front();
00076             auto_reg_->pop_front();
00077             reg(m);
00078         }
00079     
00080         delete auto_reg_;
00081         auto_reg_ = NULL;
00082     }
00083 
00084     // register the default commands
00085     if (! no_default_cmds) {
00086         HelpCommand* help = new HelpCommand();
00087         reg(help);
00088 
00089         LogCommand* log = new LogCommand();
00090         reg(log);
00091 
00092         DebugCommand* debug = new DebugCommand();
00093         reg(debug);
00094     }
00095     
00096     // evaluate the boot-time tcl commands (copied since tcl may
00097     // overwrite the string value)
00098     char* cmd = strdup(INIT_COMMAND);
00099     if (Tcl_Eval(interp_, cmd) != TCL_OK) {
00100         log_err("error in init commands: \"%s\"", interp_->result);
00101         return TCL_ERROR;
00102     }
00103     free(cmd);
00104 
00105     return TCL_OK;
00106 }
00107 
00108 TclCommandInterp::~TclCommandInterp()
00109 {
00110     log_notice("shutting down interpreter");
00111     TclCommandList::iterator iter;
00112     for (iter = commands_.begin();
00113          iter != commands_.end();
00114          ++iter)
00115     {
00116         log_debug("deleting %s command", (*iter)->name_.c_str());
00117         delete *iter;
00118     }
00119 
00120     log_debug("all commands deleted");
00121 
00122     commands_.clear();
00123 
00124     Tcl_DeleteInterp(interp_);
00125     Tcl_Release(interp_);
00126 
00127     delete lock_;
00128 }
00129 
00130 void
00131 TclCommandInterp::shutdown()
00132 {
00133     delete instance_;
00134     instance_ = NULL;
00135 }
00136 
00137 int
00138 TclCommandInterp::init(char* argv0, bool no_default_cmds)
00139 {
00140     ASSERT(instance_ == NULL);
00141     instance_ = new TclCommandInterp();
00142     
00143     return instance_->do_init(argv0, no_default_cmds);
00144 }
00145 
00146 int
00147 TclCommandInterp::exec_file(const char* file)
00148 {
00149     int err;
00150     ScopeLock l(lock_, "TclCommandInterp::exec_file");
00151 
00152     log_debug("executing command file %s", file);
00153     
00154     err = Tcl_EvalFile(interp_, (char*)file);
00155     
00156     if (err != TCL_OK) {
00157         logf(LOG_ERR, "error: line %d: '%s':\n%s",
00158              interp_->errorLine, Tcl_GetStringResult(interp_),
00159              Tcl_GetVar(interp_, "errorInfo", TCL_GLOBAL_ONLY));
00160     }
00161     
00162     return err;    
00163 }
00164 
00165 int
00166 TclCommandInterp::exec_command(const char* command)
00167 {
00168     int err;
00169     ScopeLock l(lock_, "TclCommandInterp::exec_command");
00170 
00171     // ignore empty command lines
00172     if (command[0] == '\0')
00173         return TCL_OK;
00174 
00175     // tcl modifies the command string while executing it, so we need
00176     // to make a copy
00177     char* buf = strdup(command);
00178 
00179     log_debug("executing command '%s'", buf);
00180     
00181     err = Tcl_Eval(interp_, buf);
00182     
00183     free(buf);
00184     
00185     if (err != TCL_OK) {
00186         logf(LOG_ERR, "error: line %d: '%s':\n%s",
00187              interp_->errorLine, Tcl_GetStringResult(interp_),
00188              Tcl_GetVar(interp_, "errorInfo", TCL_GLOBAL_ONLY));
00189     }
00190     
00191     return err;
00192 }
00193 
00194 void
00195 TclCommandInterp::command_server(const char* prompt,
00196                                  in_addr_t addr, u_int16_t port)
00197 {
00198     log_debug("starting command server on %s:%d", intoa(addr), port);
00199     StringBuffer cmd("command_server \"%s\" %s %d", prompt, intoa(addr), port);
00200     
00201     if (Tcl_Eval(interp_, const_cast<char*>(cmd.c_str())) != TCL_OK) {
00202         log_err("tcl error starting command_server: \"%s\"",
00203                 interp_->result);
00204     }
00205 }
00206 
00207 void
00208 TclCommandInterp::command_loop(const char* prompt)
00209 {
00210     StringBuffer cmd("command_loop \"%s\"", prompt);
00211 
00212 #if TCLREADLINE_ENABLED
00213     Tclreadline_Init(interp_);
00214 #endif
00215     
00216     if (Tcl_Eval(interp_, const_cast<char*>(cmd.c_str())) != TCL_OK) {
00217         log_err("tcl error in command_loop: \"%s\"", interp_->result);
00218     }
00219 }
00220 
00221 void
00222 TclCommandInterp::event_loop()
00223 {
00224     if (Tcl_Eval(interp_, "event_loop") != TCL_OK) {
00225         log_err("tcl error in event_loop: \"%s\"", interp_->result);
00226     }
00227 }
00228 
00229 void
00230 TclCommandInterp::exit_event_loop()
00231 {
00232     if (Tcl_Eval(interp_, "exit_event_loop") != TCL_OK) {
00233         log_err("tcl error in event_loop: \"%s\"", interp_->result);
00234     }
00235 }
00236 
00237 void
00238 TclCommandInterp::reg(TclCommand *command)
00239 {
00240     ScopeLock l(lock_, "TclCommandInterp::reg");
00241     
00242     command->logf(LOG_DEBUG, "%s command registering", command->name());
00243 
00244     Tcl_CmdInfo info;
00245     if (Tcl_GetCommandInfo(interp_, (char*)command->name(), &info) != 0) {
00246         log_warn("re-registering command %s over existing command",
00247                  command->name());
00248     }
00249                  
00250     Tcl_CreateObjCommand(interp_, 
00251                          const_cast<char*>(command->name()),
00252                          TclCommandInterp::tcl_cmd,
00253                          (ClientData)command,
00254                          NULL);
00255     
00256     commands_.push_front(command);
00257 }
00258 
00259 bool
00260 TclCommandInterp::lookup(const char* command, TclCommand** commandp)
00261 {
00262     Tcl_CmdInfo info;
00263 
00264     if (Tcl_GetCommandInfo(interp_, (char*)command, &info) == 0) {
00265         log_debug("lookup tcl command %s: does not exist", command);
00266         return false;
00267     }
00268 
00269     if (info.objProc == TclCommandInterp::tcl_cmd) {
00270         log_debug("lookup tcl command %s: exists and is TclCommand %p",
00271                   command, info.clientData);
00272         
00273         if (commandp)
00274             *commandp = (TclCommand*)info.objClientData;
00275         
00276     } else {
00277         log_debug("lookup tcl command %s: exists but is not a TclCommand",
00278                   command);
00279     }
00280 
00281     return true;
00282 }
00283 
00284 void
00285 TclCommandInterp::auto_reg(TclCommand *command)
00286 {
00287     // this should only be called from the static initializers, i.e.
00288     // we haven't been initialized yet
00289     ASSERT(instance_ == NULL);
00290 
00291     // we need to explicitly create the auto_reg list the first time
00292     // since there's no guarantee of ordering of static constructors
00293     if (!auto_reg_)
00294         auto_reg_ = new TclCommandList();
00295     
00296     auto_reg_->push_back(command);
00297 }
00298 
00299 void
00300 TclCommandInterp::reg_atexit(void(*fn)(void*), void* data)
00301 {
00302     ScopeLock l(lock_, "TclCommandInterp::reg_atexit");
00303     Tcl_CreateExitHandler(fn, data);
00304 }
00305     
00306 int 
00307 TclCommandInterp::tcl_cmd(ClientData client_data, Tcl_Interp* interp,
00308                           int objc, Tcl_Obj* const* objv)
00309 {
00310     TclCommand* command = (TclCommand*)client_data;
00311 
00312     // first check for builtin commands
00313     if (command->do_builtins_) 
00314     {
00315         if (objc >= 2) {
00316             const char* cmd = Tcl_GetStringFromObj(objv[1], NULL);
00317             if (strcmp(cmd, "cmd_info") == 0) {
00318                 return command->cmd_info(interp);
00319             }
00320 
00321             if (strcmp(cmd, "set") == 0) {
00322                 return command->cmd_set(objc, (Tcl_Obj**)objv, interp);
00323             }
00324         }
00325     }
00326 
00327     return command->exec(objc, (Tcl_Obj**)objv, interp);
00328 }
00329 
00330 void
00331 TclCommandInterp::set_result(const char* result)
00332 {
00333     Tcl_SetResult(interp_, (char*)result, TCL_VOLATILE);
00334 }
00335 
00336 void
00337 TclCommandInterp::set_objresult(Tcl_Obj* obj)
00338 {
00339     Tcl_SetObjResult(interp_, obj);
00340 }
00341 
00342 void
00343 TclCommandInterp::append_result(const char* result)
00344 {
00345     Tcl_AppendResult(interp_, (char*)result, NULL);
00346 }
00347 
00348 void
00349 TclCommandInterp::resultf(const char* fmt, ...)
00350 {
00351     StringBuffer buf;
00352     STRINGBUFFER_VAPPENDF(buf, fmt);
00353     set_result(buf.c_str());
00354 }
00355 
00356 void
00357 TclCommandInterp::append_resultf(const char* fmt, ...)
00358 {
00359     StringBuffer buf;
00360     STRINGBUFFER_VAPPENDF(buf, fmt);
00361     append_result(buf.c_str());
00362 }
00363 
00364 void
00365 TclCommandInterp::wrong_num_args(int argc, const char** argv, int parsed,
00366                                  int min, int max)
00367 {
00368     set_result("wrong number of arguments to '");
00369     append_result(argv[0]);
00370     
00371     for (int i = 1; i < parsed; ++i) {
00372         append_result(" ");
00373         append_result(argv[i]);
00374     }
00375     append_result("'");
00376 
00377     if (max == min) {
00378         append_resultf(" expected %d, got %d", min, argc);
00379     } else if (max == INT_MAX) {
00380         append_resultf(" expected at least %d, got %d", min, argc);
00381     } else {
00382         append_resultf(" expected %d - %d, got %d", min, max, argc);
00383     }
00384 }
00385 
00386 void
00387 TclCommandInterp::wrong_num_args(int objc, Tcl_Obj** objv, int parsed,
00388                                  int min, int max)
00389 {
00390     char* argv[objc];
00391     for (int i = 0; i < objc; ++i) {
00392         argv[i] = Tcl_GetStringFromObj(objv[i], NULL);
00393     }
00394     wrong_num_args(objc, (const char**)argv, parsed, min, max);
00395 }
00396 
00397 const char*
00398 TclCommandInterp::get_result()
00399 {
00400     return Tcl_GetStringResult(interp_);
00401 }
00402 
00403 /******************************************************************************
00404  *
00405  * TclCommand
00406  *
00407  *****************************************************************************/
00408 TclCommand::TclCommand(const char* name, const char* theNamespace)
00409     : Logger("TclCommand", "/command/%s", name),
00410       do_builtins_(true)
00411 {
00412 
00413     if (theNamespace != 0) {
00414         name_ += theNamespace;
00415         name_ += "::";
00416     }
00417 
00418     name_ += name;
00419 }
00420 
00421 TclCommand::~TclCommand()
00422 {
00423     BindingTable::iterator iter;
00424     for (iter = bindings_.begin(); iter != bindings_.end(); ++iter) {
00425         delete iter->second;
00426     }
00427     bindings_.clear();
00428 }
00429 
00430 int
00431 TclCommand::exec(int objc, Tcl_Obj** objv, Tcl_Interp* interp)
00432 {
00433     // If the default implementation is called, then convert all
00434     // arguments to strings and then call the other exec variant.
00435     char* argv[objc];
00436 
00437     for (int i = 0; i < objc; ++i) {
00438         argv[i] = Tcl_GetStringFromObj(objv[i], NULL);
00439     }
00440 
00441     return exec(objc, (const char**) argv, interp);
00442 }
00443 
00444 int
00445 TclCommand::exec(int argc, const char** argv, Tcl_Interp* interp)
00446 {
00447     (void)argc;
00448     (void)interp;
00449     
00450     resultf("command %s unknown argument", argv[0]);
00451     return TCL_ERROR;
00452 }
00453 
00454 void
00455 TclCommand::resultf(const char* fmt, ...)
00456 {
00457     StringBuffer buf;
00458     STRINGBUFFER_VAPPENDF(buf, fmt);
00459     TclCommandInterp::instance()->set_result(buf.c_str());
00460 }
00461 
00462 void
00463 TclCommand::append_resultf(const char* fmt, ...)
00464 {
00465     StringBuffer buf;
00466     STRINGBUFFER_VAPPENDF(buf, fmt);
00467     TclCommandInterp::instance()->append_result(buf.c_str());
00468 }
00469 
00470 
00471 int
00472 TclCommand::cmd_info(Tcl_Interp* interp)
00473 {
00474     (void)interp;
00475     
00476     StringBuffer buf;
00477 
00478     for (BindingTable::iterator itr = bindings_.begin();
00479          itr != bindings_.end(); ++itr)
00480     {
00481         buf.appendf("%s ", (*itr).first.c_str());
00482     }
00483     
00484     set_result(buf.c_str());
00485     return TCL_OK;
00486 }
00487 
00488 int
00489 TclCommand::cmd_set(int objc, Tcl_Obj** objv, Tcl_Interp* interp)
00490 {
00491     (void)interp;
00492     ASSERT(objc >= 2);
00493     
00494     // handle "set binding [value]" command
00495     if (objc < 3 || objc > 4) {
00496         resultf("wrong number of args: expected 3-4, got %d", objc);
00497         return TCL_ERROR;
00498     }
00499 
00500     const char* var = Tcl_GetStringFromObj(objv[2], NULL);
00501     int val_len = 0;
00502     const char* val = NULL;
00503     if (objc == 4) {
00504         val = Tcl_GetStringFromObj(objv[3], &val_len);
00505     }
00506     
00507     BindingTable::iterator itr;
00508     itr = bindings_.find(var);
00509     
00510     if (itr == bindings_.end()) {
00511         resultf("set: binding for %s does not exist", var);
00512         return TCL_ERROR;
00513     }
00514     Opt* opt = (*itr).second;
00515 
00516     // set value (if any)
00517     if (val) {
00518         if (opt->set(val, val_len) != 0) {
00519             resultf("%s set %s: invalid value '%s'",
00520                     Tcl_GetStringFromObj(objv[0], 0), var, val);
00521             return TCL_ERROR;
00522         }
00523     }
00524 
00525     StaticStringBuffer<256> buf;
00526     opt->get(&buf);
00527     set_result(buf.c_str());
00528 
00529     return TCL_OK;
00530 }
00531 
00532 void
00533 TclCommand::bind_var(Opt* opt)
00534 {
00535     const char* name = opt->longopt_;
00536     if (bindings_.find(name) != bindings_.end()) {
00537         if (Log::initialized()) {
00538             log_warn("warning, binding for %s already exists", name);
00539         }
00540     }
00541 
00542     bindings_[name] = opt;
00543 
00544     // we're now strict about requiring help strings
00545     ASSERT(opt->desc_ != NULL && opt->desc_[0] != '\0');
00546     
00547     StaticStringBuffer<256> subcmd("set %s", name);
00548     if (opt->valdesc_[0]) {
00549         subcmd.appendf(" <%s>", opt->valdesc_);
00550     }
00551     add_to_help(subcmd.c_str(), opt->desc_);
00552 }
00553 
00554 void
00555 TclCommand::unbind(const char* name)
00556 {
00557     BindingTable::iterator iter = bindings_.find(name);
00558 
00559     if (iter == bindings_.end()) {
00560         if (Log::initialized()) {
00561             log_warn("warning, binding for %s doesn't exist", name);
00562         }
00563         return;
00564     }
00565 
00566     if (Log::initialized()) {
00567         log_debug("removing binding for %s", name);
00568     }
00569 
00570     Opt* old = iter->second;
00571     bindings_.erase(iter);
00572 
00573     delete old;
00574 }
00575 
00576 } // namespace oasys

Generated on Sat Sep 8 08:36:18 2007 for DTN Reference Implementation by  doxygen 1.5.3