src/Draw/Draw_Interpretor.cxx

   1 // Created on: 1995-02-23
   2 // Created by: Remi LEQUETTE
   3 // Copyright (c) 1995-1999 Matra Datavision
   4 // Copyright (c) 1999-2014 OPEN CASCADE SAS
   5 //
   6 // This file is part of Open CASCADE Technology software library.
   7 //
   8 // This library is free software; you can redistribute it and/or modify it under
   9 // the terms of the GNU Lesser General Public License version 2.1 as published
  10 // by the Free Software Foundation, with special exception defined in the file
  11 // OCCT_LGPL_EXCEPTION.txt. Consult the file LICENSE_LGPL_21.txt included in OCCT
  12 // distribution for complete text of the license and disclaimer of any warranty.
  13 //
  14 // Alternatively, this file may be used under the terms of Open CASCADE
  15 // commercial license or contractual agreement.
  16
  17 #include <Draw_Interpretor.hxx>
  18 #include <Draw_Appli.hxx>
  19 #include <Standard_SStream.hxx>
  20 #include <Standard_RangeError.hxx>
  21 #include <Standard_ErrorHandler.hxx>
  22 #include <Standard_Macro.hxx>
  23
  24 #include <TCollection_AsciiString.hxx>
  25 #include <TCollection_ExtendedString.hxx>
  26 #include <OSD_Process.hxx>
  27 #include <OSD_Path.hxx>
  28 #include <OSD.hxx>
  29
  30 #include <string.h>
  31 #include <tcl.h>
  32
  33 // for capturing of cout and cerr (dup(), dup2())
  34 #ifdef _MSC_VER
  35 #include <io.h>
  36 #endif
  37 #ifdef HAVE_UNISTD_H
  38 #include <unistd.h>
  39 #endif
  40
  41 #if ! defined(STDOUT_FILENO)
  42 #define STDOUT_FILENO fileno(stdout)
  43 #endif
  44 #if ! defined(STDERR_FILENO)
  45 #define STDERR_FILENO fileno(stderr)
  46 #endif
  47
  48 #if ((TCL_MAJOR_VERSION > 8) || ((TCL_MAJOR_VERSION == 8) && (TCL_MINOR_VERSION >= 1)))
  49 #define TCL_USES_UTF8
  50 #endif
  51
  52 //
  53 // Auxiliary tool to convert strings in command arguments from UTF-8
  54 // (Tcl internal encoding since Tcl 8.1) to system local encoding,
  55 // normally extended Ascii as expected by OCC commands
  56 //
  57 class TclUTFToLocalStringSentry {
  58  public:
  59
  60 #ifdef TCL_USES_UTF8
  61   TclUTFToLocalStringSentry (int argc, const char **argv) :
  62     nb(0),
  63     TclArgv(new Tcl_DString[argc]),
  64     Argv(new char*[argc])
  65   {
  66     for (; nb < argc; nb++ ) {
  67       Tcl_UtfToExternalDString ( NULL, argv[nb], -1, &TclArgv[nb] );
  68       Argv[nb] = Tcl_DStringValue ( &TclArgv[nb] );
  69     }
  70   }
  71
  72   ~TclUTFToLocalStringSentry ()
  73   {
  74     delete[] Argv;
  75     while ( nb-- >0 ) Tcl_DStringFree ( &TclArgv[nb] );
  76     delete[] TclArgv;
  77   }
  78 #else
  79   TclUTFToLocalStringSentry (int, const char **argv) :
  80            nb(0),
  81        TclArgv(NULL),
  82            Argv((char**)argv)
  83   {}
  84 #endif
  85
  86   const char **GetArgv () const { return (const char **)Argv; }
  87
  88  private:
  89   int nb;
  90   Tcl_DString *TclArgv;
  91   char **Argv;
  92 };
  93
  94 // logging helpers
  95 namespace {
  96   void dumpArgs (Standard_OStream& os, int argc, const char *argv[])
  97   {
  98     for (int i=0; i < argc; i++)
  99       os << argv[i] << " ";
 100     os << endl;
 101   }
 102
 103   void flush_standard_streams ()
 104   {
 105     fflush (stderr);
 106     fflush (stdout);
 107     cerr << flush;
 108     cout << flush;
 109   }
 110
 111   FILE* capture_start (int std_fd, int *save_fd, char*& tmp_name)
 112   {
 113     *save_fd = 0;
 114
 115     // open temporary files
 116   #if defined(_WIN32)
 117     // use _tempnam() to decrease chances of failure (tmpfile() creates
 118     // file in root folder and will fail if it is write protected), see #24132
 119     static const char* tmpdir = getenv("TEMP");
 120     static char prefix[256] = ""; // prefix for temporary files, initialize once per process using pid
 121     if (prefix[0] == '\0')
 122       sprintf (prefix, "drawtmp%d_", (int)OSD_Process().ProcessId());
 123     tmp_name = _tempnam (tmpdir, prefix);
 124     FILE* aTmpFile = (tmp_name != NULL ? fopen (tmp_name, "w+b") : tmpfile());
 125   #else
 126     tmp_name = NULL;
 127     FILE* aTmpFile = tmpfile();
 128   #endif
 129     int fd_tmp = (aTmpFile != NULL ? fileno (aTmpFile) : -1);
 130     if (fd_tmp < 0)
 131     {
 132       cerr << "Error: cannot create temporary file for capturing console output" << endl;
 133       fclose (aTmpFile);
 134       return NULL;
 135     }
 136
 137     // remember current file descriptors of standard stream, and replace it by temporary
 138     (*save_fd) = dup(std_fd);
 139     dup2(fd_tmp, std_fd);
 140     return aTmpFile;
 141   }
 142
 143   void capture_end (FILE* tmp_file, int std_fd, int save_fd, char* tmp_name, Standard_OStream &log, Standard_Boolean doEcho)
 144   {
 145     if (! tmp_file)
 146       return;
 147
 148     // restore normal descriptors of console stream
 149     dup2 (save_fd, std_fd);
 150     close(save_fd);
 151
 152     // extract all output and copy it to log and optionally to cout
 153     const int BUFSIZE = 2048;
 154     char buf[BUFSIZE];
 155     rewind(tmp_file);
 156     while (fgets (buf, BUFSIZE, tmp_file) != NULL)
 157     {
 158       log << buf;
 159       if (doEcho)
 160         cout << buf;
 161     }
 162
 163     // close temporary file
 164     fclose (tmp_file);
 165
 166     // remove temporary file if this is not done by the system
 167     if (tmp_name)
 168       remove (tmp_name);
 169   }
 170 };
 171
 172 // MKV 29.03.05
 173 #if ((TCL_MAJOR_VERSION > 8) || ((TCL_MAJOR_VERSION == 8) && (TCL_MINOR_VERSION >= 4))) && !defined(USE_NON_CONST)
 174 static Standard_Integer CommandCmd
 175 (ClientData theClientData, Tcl_Interp *interp,
 176  Standard_Integer argc, const char* argv[])
 177 #else
 178 static Standard_Integer CommandCmd
 179 (ClientData theClientData, Tcl_Interp *interp,
 180  Standard_Integer argc, char* argv[])
 181 #endif
 182 {
 183   static Standard_Integer code;
 184   code = TCL_OK;
 185   Draw_Interpretor::CallBackData* aCallback = (Draw_Interpretor::CallBackData* )theClientData;
 186   Draw_Interpretor& di = *(aCallback->myDI);
 187
 188   // log command execution, except commands manipulating log itself and echo
 189   Standard_Boolean isLogManipulation = (strcmp (argv[0], "dlog") == 0 ||
 190                                         strcmp (argv[0], "decho") == 0);
 191   Standard_Boolean doLog  = (di.GetDoLog() && ! isLogManipulation);
 192   Standard_Boolean doEcho = (di.GetDoEcho() && ! isLogManipulation);
 193   if (doLog)
 194     dumpArgs (di.Log(), argc, argv);
 195   if (doEcho)
 196     dumpArgs (cout, argc, argv);
 197
 198   // flush cerr and cout
 199   flush_standard_streams();
 200
 201   // capture cout and cerr to log
 202   char *err_name = NULL, *out_name = NULL;
 203   FILE * aFile_err = NULL;
 204   FILE * aFile_out = NULL;
 205   int fd_err_save = 0;
 206   int fd_out_save = 0;
 207   if (doLog)
 208   {
 209     aFile_out = capture_start (STDOUT_FILENO, &fd_out_save, out_name);
 210     aFile_err = capture_start (STDERR_FILENO, &fd_err_save, err_name);
 211   }
 212
 213   // run command
 214   try {
 215     OCC_CATCH_SIGNALS
 216
 217     // get exception if control-break has been pressed
 218     OSD::ControlBreak();
 219
 220     // OCC63: Convert strings from UTF-8 to local encoding, normally expected by OCC commands
 221     TclUTFToLocalStringSentry anArgs ( argc, (const char**)argv );
 222
 223     Standard_Integer fres = aCallback->Invoke ( di, argc, anArgs.GetArgv() );
 224     if (fres != 0)
 225       code = TCL_ERROR;
 226   }
 227   catch (Standard_Failure) {
 228
 229     Handle(Standard_Failure) E = Standard_Failure::Caught();
 230
 231     // fail if Draw_ExitOnCatch is set
 232     // MKV 29.03.05
 233 #if ((TCL_MAJOR_VERSION > 8) || ((TCL_MAJOR_VERSION == 8) && (TCL_MINOR_VERSION >= 4))) && !defined(USE_NON_CONST)
 234     const char*  cc = Tcl_GetVar(interp,
 235                           "Draw_ExitOnCatch",TCL_GLOBAL_ONLY);
 236 #else
 237     char* const cc = Tcl_GetVar(interp,
 238                           "Draw_ExitOnCatch",TCL_GLOBAL_ONLY);
 239 #endif
 240
 241     cout << "An exception was caught " << E << endl;
 242
 243     if (cc && Draw::Atoi(cc)) {
 244 #ifdef WNT
 245       Tcl_Exit(0);
 246 #else
 247       Tcl_Eval(interp,"exit");
 248 #endif
 249     }
 250
 251     // get the error message
 252     Standard_SStream ss;
 253     ss << "** Exception ** " << E << ends ;
 254 #ifdef USE_STL_STREAM
 255     Tcl_SetResult(interp,(char*)(ss.str().c_str()),TCL_VOLATILE);
 256 #else
 257     Tcl_SetResult(interp,(char*)(ss.str()),TCL_VOLATILE);
 258 #endif
 259     code = TCL_ERROR;
 260   }
 261
 262   // flush streams
 263   flush_standard_streams();
 264
 265   // end capturing cout and cerr
 266   if (doLog)
 267   {
 268     capture_end (aFile_err, STDERR_FILENO, fd_err_save, err_name, di.Log(), doEcho);
 269     capture_end (aFile_out, STDOUT_FILENO, fd_out_save, out_name, di.Log(), doEcho);
 270   }
 271
 272   // log command result
 273   const char* aResultStr = NULL;
 274   if (doLog)
 275   {
 276     aResultStr = Tcl_GetStringResult (interp);
 277     if (aResultStr != 0 && aResultStr[0] != '\0' )
 278       di.Log() << Tcl_GetStringResult (interp) << endl;
 279   }
 280   if (doEcho)
 281   {
 282     if (aResultStr == NULL)
 283       aResultStr = Tcl_GetStringResult (interp);
 284     if (aResultStr != 0 && aResultStr[0] != '\0' )
 285       cout << Tcl_GetStringResult (interp) << endl;
 286   }
 287
 288   return code;
 289 }
 290
 291 static void CommandDelete (ClientData theClientData)
 292 {
 293   Draw_Interpretor::CallBackData* aCallback = (Draw_Interpretor::CallBackData* )theClientData;
 294   delete aCallback;
 295 }
 296
 297 //=======================================================================
 298 //function : Draw_Interpretor
 299 //purpose  :
 300 //=======================================================================
 301
 302 Draw_Interpretor::Draw_Interpretor() :
 303   isAllocated(Standard_False), myDoLog(Standard_False), myDoEcho(Standard_False)
 304 {
 305 // The tcl interpreter is not created immediately as it is kept
 306 // by a global variable and created and deleted before the main().
 307   myInterp  = NULL;
 308 }
 309
 310 //=======================================================================
 311 //function : Init
 312 //purpose  : It is necessary to call this function
 313 //=======================================================================
 314
 315 void Draw_Interpretor::Init()
 316 {
 317   if (isAllocated)
 318     Tcl_DeleteInterp(myInterp);
 319   isAllocated=Standard_True;
 320   myInterp=Tcl_CreateInterp();
 321 }
 322
 323 //=======================================================================
 324 //function : Draw_Interpretor
 325 //purpose  :
 326 //=======================================================================
 327
 328 Draw_Interpretor::Draw_Interpretor(const Draw_PInterp& p) :
 329   isAllocated(Standard_False),
 330   myInterp(p),
 331   myDoLog(Standard_False),
 332   myDoEcho(Standard_False)
 333 {
 334 }
 335
 336 //=======================================================================
 337 //function : add
 338 //purpose  :
 339 //=======================================================================
 340 void Draw_Interpretor::add (const Standard_CString          theCommandName,
 341                             const Standard_CString          theHelp,
 342                             const Standard_CString          theFileName,
 343                             Draw_Interpretor::CallBackData* theCallback,
 344                             const Standard_CString          theGroup)
 345 {
 346   if (myInterp == NULL)
 347   {
 348     Init();
 349   }
 350
 351   Standard_PCharacter aName  = (Standard_PCharacter )theCommandName;
 352   Standard_PCharacter aHelp  = (Standard_PCharacter )theHelp;
 353   Standard_PCharacter aGroup = (Standard_PCharacter )theGroup;
 354   Tcl_CreateCommand (myInterp, aName, CommandCmd, (ClientData )theCallback, CommandDelete);
 355
 356   // add the help
 357   Tcl_SetVar2 (myInterp, "Draw_Helps",  aName,  aHelp, TCL_GLOBAL_ONLY);
 358   Tcl_SetVar2 (myInterp, "Draw_Groups", aGroup, aName,
 359                      TCL_GLOBAL_ONLY | TCL_APPEND_VALUE | TCL_LIST_ELEMENT);
 360
 361   // add path to source file (keep not more than two last subdirectories)
 362   if (theFileName  == NULL
 363    || *theFileName == '\0')
 364   {
 365     return;
 366   }
 367
 368   OSD_Path aPath (theFileName);
 369   Standard_Integer nbTrek = aPath.TrekLength();
 370   for (Standard_Integer i = 2; i < nbTrek; ++i)
 371   {
 372     aPath.RemoveATrek (1);
 373   }
 374   aPath.SetDisk ("");
 375   aPath.SetNode ("");
 376   TCollection_AsciiString aSrcPath;
 377   aPath.SystemName (aSrcPath);
 378   Tcl_SetVar2 (myInterp, "Draw_Files", aName, aSrcPath.ToCString(), TCL_GLOBAL_ONLY);
 379 }
 380
 381 //=======================================================================
 382 //function : Remove
 383 //purpose  :
 384 //=======================================================================
 385
 386 Standard_Boolean Draw_Interpretor::Remove(Standard_CString const n)
 387 {
 388   Standard_PCharacter pN;
 389   //
 390   pN=(Standard_PCharacter)n;
 391
 392   Standard_Integer result = Tcl_DeleteCommand(myInterp,pN);
 393   return result == 0;
 394 }
 395
 396 //=======================================================================
 397 //function : Result
 398 //purpose  :
 399 //=======================================================================
 400
 401 Standard_CString Draw_Interpretor::Result() const
 402 {
 403 #if ((TCL_MAJOR_VERSION > 8) || ((TCL_MAJOR_VERSION == 8) && (TCL_MINOR_VERSION >= 5)))
 404   return Tcl_GetStringResult(myInterp);
 405 #else
 406   return myInterp->result;
 407 #endif
 408 }
 409
 410 //=======================================================================
 411 //function : Reset
 412 //purpose  :
 413 //=======================================================================
 414
 415 void Draw_Interpretor::Reset()
 416 {
 417   Tcl_ResetResult(myInterp);
 418 }
 419
 420 //=======================================================================
 421 //function : Append
 422 //purpose  :
 423 //=======================================================================
 424
 425 Draw_Interpretor& Draw_Interpretor::Append(const Standard_CString s)
 426 {
 427 #ifdef TCL_USES_UTF8
 428   // Convert string to UTF-8 format for Tcl
 429   Tcl_DString TclString;
 430   Tcl_ExternalToUtfDString ( NULL, s, -1, &TclString );
 431   Tcl_AppendResult ( myInterp, Tcl_DStringValue ( &TclString ), (Standard_CString)0 );
 432   Tcl_DStringFree ( &TclString );
 433 #else
 434   Tcl_AppendResult(myInterp,s,(Standard_CString)0);
 435 #endif
 436   return *this;
 437 }
 438
 439 //=======================================================================
 440 //function : Append
 441 //purpose  :
 442 //=======================================================================
 443
 444 Draw_Interpretor& Draw_Interpretor::Append(const TCollection_AsciiString& s)
 445 {
 446   return Append (s.ToCString());
 447 }
 448
 449 //=======================================================================
 450 //function : Append
 451 //purpose  :
 452 //=======================================================================
 453
 454 Draw_Interpretor& Draw_Interpretor::Append(const TCollection_ExtendedString& theString)
 455 {
 456 #ifdef TCL_USES_UTF8
 457   // Convert string to UTF-8 format for Tcl
 458   char *str = new char[theString.LengthOfCString()+1];
 459   theString.ToUTF8CString (str);
 460   Tcl_AppendResult ( myInterp, str, (Standard_CString)0 );
 461   delete[] str;
 462 #else
 463   // put as ascii string, replacing non-ascii characters by '?'
 464   TCollection_AsciiString str (theString, '?');
 465   Tcl_AppendResult(myInterp,str.ToCString(),(Standard_CString)0);
 466 #endif
 467   return *this;
 468 }
 469
 470 //=======================================================================
 471 //function : Append
 472 //purpose  :
 473 //=======================================================================
 474
 475 Draw_Interpretor& Draw_Interpretor::Append(const Standard_Integer i)
 476 {
 477   char c[100];
 478   Sprintf(c,"%d",i);
 479   Tcl_AppendResult(myInterp,c,(Standard_CString)0);
 480   return *this;
 481 }
 482
 483 //=======================================================================
 484 //function : Append
 485 //purpose  :
 486 //=======================================================================
 487
 488 Draw_Interpretor& Draw_Interpretor::Append(const Standard_Real r)
 489 {
 490   char s[100];
 491   Sprintf(s,"%.17g",r);
 492   Tcl_AppendResult(myInterp,s,(Standard_CString)0);
 493   return *this;
 494 }
 495
 496 //=======================================================================
 497 //function : Append
 498 //purpose  :
 499 //=======================================================================
 500
 501 Draw_Interpretor& Draw_Interpretor::Append(const Standard_SStream& s)
 502 {
 503 #ifdef USE_STL_STREAM
 504   return Append (s.str().c_str());
 505 #else
 506   // Note: use dirty tricks -- unavoidable with old streams
 507   TCollection_AsciiString aStr (((Standard_SStream&)AReason).str(), AReason.pcount());
 508   ((Standard_SStream&)AReason).freeze (false);
 509   return Append (aStr.ToCString());
 510 #endif
 511 }
 512
 513 //=======================================================================
 514 //function : AppendElement
 515 //purpose  :
 516 //=======================================================================
 517
 518 void Draw_Interpretor::AppendElement(const Standard_CString s)
 519 {
 520 #ifdef TCL_USES_UTF8
 521   // Convert string to UTF-8 format for Tcl
 522   Tcl_DString TclString;
 523   Tcl_ExternalToUtfDString ( NULL, s, -1, &TclString );
 524   Tcl_AppendElement ( myInterp, Tcl_DStringValue ( &TclString ) );
 525   Tcl_DStringFree ( &TclString );
 526 #else
 527 #ifdef IRIX
 528   //AppendElement is declared as (Tcl_Interp *interp, char *string)
 529   //on SGI 32
 530   Tcl_AppendElement(myInterp,(char*) s);
 531 #else
 532   Tcl_AppendElement(myInterp, s);
 533 #endif
 534 #endif
 535 }
 536
 537 //=======================================================================
 538 //function : Eval
 539 //purpose  :
 540 //=======================================================================
 541
 542 Standard_Integer Draw_Interpretor::Eval(const Standard_CString line)
 543 {
 544   Standard_PCharacter pLine;
 545   //
 546   pLine=(Standard_PCharacter)line;
 547   //
 548   return Tcl_Eval(myInterp,pLine);
 549 }
 550
 551
 552 //=======================================================================
 553 //function : Eval
 554 //purpose  :
 555 //=======================================================================
 556
 557 Standard_Integer Draw_Interpretor::RecordAndEval(const Standard_CString line,
 558                                                  const Standard_Integer flags)
 559 {
 560   Standard_PCharacter pLine;
 561   //
 562   pLine=(Standard_PCharacter)line;
 563   return Tcl_RecordAndEval(myInterp,pLine,flags);
 564 }
 565
 566 //=======================================================================
 567 //function : EvalFile
 568 //purpose  :
 569 //=======================================================================
 570
 571 Standard_Integer Draw_Interpretor::EvalFile(const Standard_CString fname)
 572 {
 573   Standard_PCharacter pfname;
 574   //
 575   pfname=(Standard_PCharacter)fname;
 576   return Tcl_EvalFile(myInterp,pfname);
 577 }
 578
 579 //=======================================================================
 580 //function : PrintHelp
 581 //purpose  :
 582 //=======================================================================
 583
 584 Standard_Integer Draw_Interpretor::PrintHelp (const Standard_CString theCommandName)
 585 {
 586   TCollection_AsciiString aCmd     = TCollection_AsciiString ("help ") + theCommandName;
 587   Standard_PCharacter     aLinePtr = (Standard_PCharacter )aCmd.ToCString();
 588   return Tcl_Eval (myInterp, aLinePtr);
 589 }
 590
 591 //=======================================================================
 592 //function :Complete
 593 //purpose  :
 594 //=======================================================================
 595
 596 Standard_Boolean Draw_Interpretor::Complete(const Standard_CString line)
 597 {
 598   Standard_PCharacter pLine;
 599   //
 600   pLine=(Standard_PCharacter)line;
 601   return Tcl_CommandComplete(pLine);
 602 }
 603
 604 //=======================================================================
 605 //function : Destroy
 606 //purpose  :
 607 //=======================================================================
 608
 609 Draw_Interpretor::~Draw_Interpretor()
 610 {
 611   // MKV 01.02.05
 612 #if ((TCL_MAJOR_VERSION > 8) || ((TCL_MAJOR_VERSION == 8) && (TCL_MINOR_VERSION >= 4)))
 613   try {
 614     OCC_CATCH_SIGNALS
 615     Tcl_Exit(0);
 616   }
 617   catch (Standard_Failure) {
 618 #ifdef DEB
 619     cout <<"Tcl_Exit have an exeption" << endl;
 620 #endif
 621   }
 622 #else
 623 #ifdef WNT
 624   Tcl_Exit(0);
 625 #endif
 626 #endif
 627 }
 628
 629 //=======================================================================
 630 //function : Interp
 631 //purpose  :
 632 //=======================================================================
 633
 634 Draw_PInterp Draw_Interpretor::Interp() const
 635 {
 636   Standard_DomainError_Raise_if (myInterp==NULL , "No call for  Draw_Interpretor::Init()");
 637   return myInterp;
 638 }
 639
 640 void Draw_Interpretor::Set(const Draw_PInterp& PIntrp)
 641 {
 642   if (isAllocated)
 643     Tcl_DeleteInterp(myInterp);
 644   isAllocated = Standard_False;
 645   myInterp = PIntrp;
 646 }
 647
 648 //=======================================================================
 649 //function : Logging
 650 //purpose  :
 651 //=======================================================================
 652
 653 void Draw_Interpretor::SetDoLog (Standard_Boolean doLog)
 654 {
 655   myDoLog = doLog;
 656 }
 657
 658 void Draw_Interpretor::SetDoEcho (Standard_Boolean doEcho)
 659 {
 660   myDoEcho = doEcho;
 661 }
 662
 663 Standard_Boolean Draw_Interpretor::GetDoLog () const
 664 {
 665   return myDoLog;
 666 }
 667
 668 Standard_Boolean Draw_Interpretor::GetDoEcho () const
 669 {
 670   return myDoEcho;
 671 }
 672
 673 Standard_SStream& Draw_Interpretor::Log ()
 674 {
 675   return myLog;
 676 }