Ejemplo n.º 1
0
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;
}
Ejemplo n.º 2
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;
}
Ejemplo n.º 3
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;
}
Ejemplo n.º 4
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' **/