int
BasicGFunEvaluator::uParse(char *tempchar, int *node, int *dirn, char* disp, char* varName, char* arrName)
{
// this is deprecated but keep in there for now
// match regular expressions of known lsf parameters
char* pattern = {"(ud*)\\(([0-9]+),([0-9]+)\\)"};
const char* first;
const char* last;
char par_result[30];
// save instances of parameters
Tcl_RegExp regexp = Tcl_RegExpCompile(theTclInterp, pattern);
if (regexp == NULL) {
opserr << "GFunEvaluator::uParse ERROR compiling regular expression -- " << pattern << endln;
opserr << theTclInterp->result << endln;
}
if ( Tcl_RegExpExec(theTclInterp, regexp, tempchar, tempchar) == 1 ) {
// match found
// get var name
Tcl_RegExpRange(regexp, 1, &first, &last);
if (first) {
strncpy(par_result,first,last-first);
par_result[last-first] = '\0';
strcpy(varName, par_result);
if ( strncmp(par_result, "udd", 3) == 0 )
strcpy(disp,"accel");
else if ( strncmp(par_result, "ud", 2) == 0 )
strcpy(disp,"vel");
else if ( strncmp(par_result, "u", 1) == 0 )
strcpy(disp,"disp");
}
// get node number
Tcl_RegExpRange(regexp, 2, &first, &last);
if (first) {
strncpy(par_result,first,last-first);
par_result[last-first] = '\0';
*node = atoi(par_result);
}
// get direction
Tcl_RegExpRange(regexp, 3, &first, &last);
if (first) {
strncpy(par_result,first,last-first);
par_result[last-first] = '\0';
*dirn = atoi(par_result);
}
sprintf(arrName,"%d,%d",*node,*dirn);
}
return 0;
}
int
BasicGFunEvaluator::nodeParse(char *tempchar, int *node, int *dirn, char* disp, char* varName, char* arrName)
{
// match regular expressions of known lsf parameters
char* pattern = {"((rec_)?node)\\(([0-9]+),([0-9]+),([a-z]+)\\)"};
const char* first;
const char* last;
char par_result[30];
// save instances of parameters
Tcl_RegExp regexp = Tcl_RegExpCompile(theTclInterp, pattern);
if (regexp == NULL) {
opserr << "GFunEvaluator::nodeParse ERROR compiling regular expression -- " << pattern << endln;
opserr << theTclInterp->result << endln;
}
if ( Tcl_RegExpExec(theTclInterp, regexp, tempchar, tempchar) == 1 ) {
// match found
// get var name
Tcl_RegExpRange(regexp, 1, &first, &last);
if (first) {
strncpy(par_result,first,last-first);
par_result[last-first] = '\0';
strcpy(varName, par_result);
}
// get node number
Tcl_RegExpRange(regexp, 3, &first, &last);
if (first) {
strncpy(par_result,first,last-first);
par_result[last-first] = '\0';
*node = atoi(par_result);
}
// get direction
Tcl_RegExpRange(regexp, 4, &first, &last);
if (first) {
strncpy(par_result,first,last-first);
par_result[last-first] = '\0';
*dirn = atoi(par_result);
}
// get response type
Tcl_RegExpRange(regexp, 5, &first, &last);
if (first) {
strncpy(par_result,first,last-first);
par_result[last-first] = '\0';
strcpy(disp, par_result);
}
sprintf(arrName,"%d,%d,%s",*node,*dirn,disp);
}
return 0;
}
int
Tcl_RegExpMatch(
Tcl_Interp *interp, /* Used for error reporting. May be NULL. */
const char *text, /* Text to search for pattern matches. */
const char *pattern) /* Regular expression to match against text. */
{
Tcl_RegExp re = Tcl_RegExpCompile(interp, pattern);
if (re == NULL) {
return -1;
}
return Tcl_RegExpExec(interp, re, text, text);
}
// modifed from: http://shootout.alioth.debian.org/u32/program.php?test=regexdna&lang=gcc&id=1
int main(int argc, char *argv[])
{
char *buf, *q;
int l = 0;
Tcl_RegExp r;
if (argc == 1) {
fprintf(stderr, "Usage: cat in.file | %s <regexp>\n", argv[0]);
return 0;
}
Tcl_FindExecutable(argv[0]);
r = Tcl_RegExpCompile(0, argv[1]);
buf = calloc(BUF_SIZE, 1);
while (fgets(buf, BUF_SIZE - 1, stdin)) {
++l;
for (q = buf; *q; ++q); if (q > buf) *--q = 0;
if (Tcl_RegExpExec(0, r, buf, 0))
printf("%d:%s\n", l, buf);
}
free(buf);
return 0;
}
int
LimitStateFunction::tokenizeIt(const char *originalExpression)
{
// Can automatically convert Terje's {} stuff to proper Tcl syntax
// in this method, e.g., {x_1} --> \$x(1) and {u_5_2} --> \[nodeDisp 5 2]
//
// implementation of any new patterns needs to also be reflected in gfunction and sensitivity algorithm
char separators[] = "}{";
int deprecated = strcspn(originalExpression, separators);
int originalLen = strlen(originalExpression);
if (deprecated < originalLen) {
opserr << "WARNING: Limit state function " << this->getTag() << " contains OLD syntax "
<< "that uses {x_1}, {u_1_1}, {file_fileName_1_1}, etc. " << endln;
opserr << "Use new Tcl variable syntax \\$x(1), \\$u(1,1), etc." << endln << endln;
opserr << "Just a note (from KRM) about the deprecated LSF syntax:\n"
<< "you can still use RVs in your LSF, however, they are now specified directly:\n"
<< " {x_2} --> \\$xrv(2)\n"
<< "if you feel really nostalgic, you can still write the following:\n"
<< " {x_2} --> \\$x_2\n"
<< "however the second option will go away at some point.\n" << endln
<< "Nodal commands now work as follows:\n"
<< " {u_1_2} --> \\$u(1,2)\n"
<< " {u_1_2} --> \\[nodeDisp 1 2]\n"
<< " {u_1_2} --> \\$node(1,2,disp) or \\$rec_node(1,2,disp)\n"
<< " {ud_1_2} --> \\$rec_node(1,2,vel) or \\$ud(1,2)\n"
<< " etc., etc.\n" << endln
<< "Element forces can be defined in the same way and are element dependent:\n"
<< " \\$element(2,localForce_1) would give you column 1 of ele 2 localForce\n"
<< " \\$rec_element(1,section_2_force_1), etc, etc.\n" << endln
<< "Also, the code in this file also allowed reading of values from a file.\n"
<< "This too can be implemented more directly by the user simply by using \n"
<< "standard Tcl variables. ie., instead of computing a value, writing it \n"
<< "to a file, and then using file_fileName_1_2 or whatever, now:\n"
<< " {file_fileName_1_2} --> \\$yourTclVariable\n" << endln
<< "Limit state function parameters can now be specified and used, both for \n"
<< "sensitivity studies, and for parametricReliabilityAnalysis:\n"
<< " {par_1} --> \\$par(1)\n" << endln
<< "And a final note, if a particular GFunEvaluator is still obsessed with\n"
<< "case-specific LSF arguments, they can still be implemented through \n"
<< "the tokenizeSpecials() function. However, they must be specified in \n"
<< "standard Tcl syntax and the values initialized in your own script.\n" << endln
<< "If you are using DDM, the \\[nodeDisp 1 2] or similar commands will not \n"
<< "work because there is no way to perturb these to calculate dg/du. So \n"
<< "if you are doing DDM, use the \\$u(1,2), \\$ud(1,2), etc syntax. For \n"
<< "DDM, you can also use element forces (if sensitivities are coded).\n" << endln;
exit(-1);
}
// now match regular expressions of known lsf parameters
// Note: lsf parameters are not the same as the Parameter class in OS domain.
const int numberOfParamTypes = 5;
char* pattern[numberOfParamTypes] = {"x(_|rv\\()[0-9]+\\)?",
"ud*\\([0-9]+,[0-9]+\\)",
"(rec_)?node\\([0-9]+,[0-9]+,[a-z]+\\)",
"(rec_)?element\\([0-9]+,[a-zA-Z0-9_]+\\)",
"par\\([0-9]+\\)"};
const char* first;
const char* last;
char par_result[30];
// initialize the tcl list object
paramList = Tcl_NewListObj(0,NULL);
// cycle through pattern types and save instances of parameters to tcl list object
for (int ireg = 0; ireg < numberOfParamTypes; ireg++) {
Tcl_RegExp regexp = Tcl_RegExpCompile(theTclInterp, pattern[ireg]);
if (regexp == NULL) {
opserr << "LSF::tokenizeIt ERROR compiling regular expression -- " << pattern[ireg] << endln;
opserr << theTclInterp->result << endln;
}
char* current = new char[originalLen+1];
strcpy(current,originalExpression);
while ( Tcl_RegExpExec(theTclInterp, regexp, current, current) == 1 ) {
// match found
Tcl_RegExpRange(regexp, 0, &first, &last);
if (first) {
strncpy(par_result,first,last-first);
par_result[last-first] = '\0';
//opserr << "Found: " << par_result << endln;
Tcl_Obj *tempStr = Tcl_NewStringObj(par_result,last-first);
//opserr << Tcl_GetStringFromObj(tempStr,NULL) << endln;
if (Tcl_ListObjAppendElement(theTclInterp, paramList, tempStr) != TCL_OK) {
opserr << "LSF::tokenizeIt ERROR creating list element from " << par_result << endln;
opserr << theTclInterp->result << endln;
}
}
strcpy(current, last);
}
delete [] current;
}
//Tcl_IncrRefCount(paramList);
return 0;
}
int cmdSetPath(ClientData client_data, Tcl_Interp *interp, int argc,
CONST84 char *argv[])
{
Tcl_RegExp chkexpPtr; /** Regular expression for
* marker checking **/
char *oldpath, /** Old value of 'var' **/
*newpath, /** New value of 'var' **/
*sw_marker = APP_SW_MARKER, /** arbitrary default **/
*startp = NULL, *endp = NULL, /** regexp match endpts **/
*qualifiedpath, /** List of dirs which
* are NOT already in path **/
**pathlist; /** List of dirs **/
const char *delim = _colon; /** path delimiter **/
int append = 1, /** append or prepend **/
numpaths, /** number of dirs in path **/
qpathlen, /** qualifiedpath length **/
arg1 = 1, /** arg start **/
x; /** loop index **/
Tcl_Obj *np_obj; /** new path Tcl Obj **/
#if WITH_DEBUGGING_CALLBACK
ErrorLogger(NO_ERR_START, LOC, _proc_cmdSetPath, NULL);
#endif /* WITH_DEBUGGING_CALLBACK */
/**
** Whatis mode?
**/
if (g_flags & (M_WHATIS | M_HELP)) {
goto success0;
}
/**
** Check arguments. There should be at least 3 args:
** argv[0] - prepend/append
** ...
** argv[n-1]- varname
** argv[n] - value
**/
if(argc < 3) {
if (OK != ErrorLogger(ERR_USAGE, LOC, argv[0],
" path-variable directory", NULL)) {
goto unwind0;
}
}
/**
** Should this guy be removed from the variable(?)... If yes, then do so!
**/
if (g_flags & M_REMOVE) {
return (cmdRemovePath(client_data, interp, argc, argv)); /** ----> **/
}
/**
** prepend or append. The default is append.
**/
if (!(append = !!strncmp(argv[0], "pre", 3))) {
sw_marker = PRE_SW_MARKER;
}
/**
** Non-persist mode?
**/
if (g_flags & M_NONPERSIST) {
return (TCL_OK);
}
/**
** Display only ... ok, let us do so!
**/
if (g_flags & M_DISPLAY) {
fprintf(stderr, "%s\t ", argv[0]);
while (--argc) {
fprintf( stderr, "%s ", *++argv);
}
fprintf(stderr, "\n");
goto success0;
}
/**
** Check for the delimiter option
**/
if (*(argv[arg1]) == '-') {
if (!strcmp(argv[arg1], "-d")) {
delim = argv[(arg1 + 1)];
arg1 += 2;
} else if (!strcmp(argv[arg1], "--delim")) {
delim = argv[(arg1 + 1)];
arg1 += 2;
} else if (!strncmp(argv[arg1], "--delim=", 8)) {
delim = (argv[arg1] + 8);
arg1++;
}
}
/**
** Get the old value of the variable. MANPATH defaults to a configure
** generated value.
** Put a \ in front of each '.' and '+'.
** (this is an intentional memory leak)
**/
oldpath = EMGetEnv(interp, argv[arg1]);
_TCLCHK(interp)
if(!oldpath || !*oldpath) {
null_free((void *) &oldpath);
oldpath = ((!strcmp(argv[arg1], "MANPATH"))
? stringer(NULL, 0, DEFAULTMANPATH, NULL)
: stringer(NULL, 0, "", NULL));
}
/**
** Split the new path into its components directories so each
** directory can be checked to see whether it is already in the
** existing path.
**/
if (!(pathlist = SplitIntoList(interp, (char *)argv[(arg1 + 1)],
&numpaths, delim))) {
goto unwind0;
}
/**
** Some space for the list of paths which
** are not already in the existing path.
**/
if((char *) NULL == (qualifiedpath = stringer(NULL, 0, argv[(arg1 + 1)],
delim, NULL))) {
if (OK != ErrorLogger(ERR_STRING, LOC, NULL)) {
goto unwind1;
}
}
qpathlen = (int)(strlen(qualifiedpath) + 1);
*qualifiedpath = '\0'; /** make sure null for later **/
for ((x = 0); (x < numpaths); x++) {
regex_quote(pathlist[x], buffer, PATH_BUFLEN);
/**
** Check to see if path is already in this path variable.
** It could be at the
** beginning ... ^path:
** middle ... :path:
** end ... :path$
** only one ... ^path$
**/
if ((char *)NULL == (newpath = stringer(NULL, 0, "(^", buffer, delim,
")|(", delim, buffer, delim,
")|(", delim, buffer, "$)|(^",
buffer, "$)", NULL))) {
if (OK != ErrorLogger( ERR_STRING, LOC, NULL)) {
goto unwind2;
}
}
np_obj = Tcl_NewStringObj(newpath, (int)strlen(newpath));
chkexpPtr = Tcl_GetRegExpFromObj(interp, np_obj, TCL_REG_ADVANCED);
_TCLCHK(interp)
null_free((void *)&newpath);
/**
** If the directory is not already in the path,
** add it to the qualified path.
**/
if (!Tcl_RegExpExec(interp, chkexpPtr, oldpath, oldpath)) {
if (!stringer((qualifiedpath + strlen(qualifiedpath)),
(int)((unsigned long)qpathlen - strlen(qualifiedpath)),
pathlist[x], delim, NULL)) {
if (OK != ErrorLogger(ERR_STRING, LOC, NULL)) {
goto unwind2;
}
}
}
} /** End of loop that checks for
** already existent path
**/
/**
** If all of the directories in the new path already exist,
** exit doing nothing.
**/
if (! *qualifiedpath) {
goto success1;
}
/* remove trailing delimiter */
qualifiedpath[(strlen(qualifiedpath) - 1)] = '\0';
/**
** Some space for our newly created path.
** We size at the oldpath plus the addition.
**/
if (!(newpath = stringer(NULL, (int)(strlen(oldpath) + strlen(qualifiedpath) + 2), NULL))) {
if (OK != ErrorLogger(ERR_STRING, LOC, NULL)) {
goto unwind2;
}
}
*newpath = '\0';
/**
** Easy job to do, if the old path has not been set up so far ...
**/
if (!strcmp(oldpath, "")) {
strcpy(newpath, qualifiedpath);
/**
** Otherwise we have to take care on prepending vs. appending ...
** If there is a append or prepend marker within the variable (see
** modules_def.h) the changes are made according to this markers. Other-
** wise append and prepend will be relative to the strings begin or end.
**/
} else {
Tcl_Obj *sw_obj = Tcl_NewStringObj(sw_marker, (int)strlen(sw_marker));
Tcl_RegExp markexpPtr = Tcl_GetRegExpFromObj(interp,
sw_obj,
TCL_REG_ADVANCED);
_TCLCHK(interp)
strcpy(newpath, oldpath);
if (Tcl_RegExpExec(interp, markexpPtr, oldpath, oldpath)) {
_TCLCHK(interp)
Tcl_RegExpRange(markexpPtr, 0,
(CONST84 char **)&startp, (CONST84 char **)&endp);
/**
** Append/Prepend marker found
**/
if (append) {
char ch = *startp;
*startp = '\0';
strcpy(newpath, oldpath);
/**
** check that newpath has a value before adding delim
**/
if ((strlen(newpath) > 0) &&
(newpath[(strlen(newpath) - 1)] != *delim)) {
strcat(newpath, delim);
}
strcat(newpath, qualifiedpath);
if (newpath[strlen(newpath)-1] != *delim) {
strcat(newpath, delim);
}
*startp = ch;
strcat(newpath, startp);
} else {
char ch = *endp;
*endp = '\0';
strcpy(newpath, oldpath);
if (newpath[strlen(newpath)-1] != *delim) {
strcat(newpath, delim);
}
strcat(newpath, qualifiedpath);
*endp = ch;
strcat(newpath, endp);
}
} else {
/**
** No marker set
**/
if (append) {
strcpy(newpath, oldpath);
if (newpath[strlen(newpath)-1] != *delim) {
strcat(newpath, delim);
}
strcat(newpath, qualifiedpath);
} else {
strcpy(newpath, qualifiedpath);
if (*oldpath != *delim) {
strcat(newpath, delim);
}
strcat(newpath, oldpath);
} /* end "if (append)" */
} /** end "if (marker)" **/
} /** end "if (strcmp)" **/
/**
** Now the new value to be set resides in 'newpath'. Set it up.
**/
moduleSetenv(interp, (char *)argv[arg1], newpath, 1);
_TCLCHK(interp)
#if WITH_DEBUGGING_CALLBACK
ErrorLogger(NO_ERR_END, LOC, _proc_cmdSetPath, NULL);
#endif /* WITH_DEBUGGING_CALLBACK */
/**
** Free resources
**/
null_free((void *)&newpath);
success1:
null_free((void *)&oldpath);
null_free((void *)&qualifiedpath);
FreeList(pathlist, numpaths);
success0:
return (TCL_OK); /** -------- EXIT (SUCCESS) -------> **/
unwind2:
null_free((void *)&qualifiedpath);
unwind1:
FreeList(pathlist, numpaths);
unwind0:
null_free((void *)&oldpath);
return (TCL_ERROR); /** -------- EXIT (FAILURE) -------> **/
} /** End of 'cmdSetPath' **/
