Actual source code: str.c
2: /*
3: We define the string operations here. The reason we just do not use
4: the standard string routines in the PETSc code is that on some machines
5: they are broken or have the wrong prototypes.
7: */
8: #include <petscsys.h> /*I "petscsys.h" I*/
9: #if defined(PETSC_HAVE_STRING_H)
10: #include <string.h>
11: #endif
12: #if defined(PETSC_HAVE_STRINGS_H)
13: #include <strings.h>
14: #endif
18: /*@C
19: PetscStrToArray - Seperates a string by its spaces and creates an array of strings
21: Not Collective
23: Input Parameters:
24: . s - pointer to string
26: Output Parameter:
27: + argc - the number of entries in the array
28: - args - an array of the entries with a null at the end
30: Level: intermediate
32: Notes: this may be called before PetscInitialize() or after PetscFinalize()
34: Not for use in Fortran
36: Developer Notes: Using raw malloc() and does not call error handlers since this may be used before PETSc is initialized. Used
37: to generate argc, args arguments passed to MPI_Init()
39: .seealso: PetscStrToArrayDestroy(), PetscToken, PetscTokenCreate()
41: @*/
42: PetscErrorCode PetscStrToArray(const char s[],int *argc,char ***args)
43: {
44: int i,n,*lens,cnt = 0;
45: PetscBool flg = PETSC_FALSE;
47: n = strlen(s);
48: *argc = 0;
49: for (i=0; i<n; i++) {
50: if (s[i] != ' ') break;
51: }
52: for (;i<n+1; i++) {
53: if ((s[i] == ' ' || s[i] == 0) && !flg) {flg = PETSC_TRUE; (*argc)++;}
54: else if (s[i] != ' ') {flg = PETSC_FALSE;}
55: }
56: (*args) = (char **) malloc(((*argc)+1)*sizeof(char**)); if (!*args) return PETSC_ERR_MEM;
57: lens = (int*) malloc((*argc)*sizeof(int)); if (!lens) return PETSC_ERR_MEM;
58: for (i=0; i<*argc; i++) lens[i] = 0;
60: *argc = 0;
61: for (i=0; i<n; i++) {
62: if (s[i] != ' ') break;
63: }
64: for (;i<n+1; i++) {
65: if ((s[i] == ' ' || s[i] == 0) && !flg) {flg = PETSC_TRUE; (*argc)++;}
66: else if (s[i] != ' ') {lens[*argc]++;flg = PETSC_FALSE;}
67: }
69: for (i=0; i<*argc; i++) {
70: (*args)[i] = (char*) malloc((lens[i]+1)*sizeof(char)); if (!(*args)[i]) return PETSC_ERR_MEM;
71: }
72: (*args)[*argc] = 0;
74: *argc = 0;
75: for (i=0; i<n; i++) {
76: if (s[i] != ' ') break;
77: }
78: for (;i<n+1; i++) {
79: if ((s[i] == ' ' || s[i] == 0) && !flg) {flg = PETSC_TRUE; (*args)[*argc][cnt++] = 0; (*argc)++; cnt = 0;}
80: else if (s[i] != ' ' && s[i] != 0) {(*args)[*argc][cnt++] = s[i]; flg = PETSC_FALSE;}
81: }
82: return 0;
83: }
87: /*@C
88: PetscStrToArrayDestroy - Frees array created with PetscStrToArray().
90: Not Collective
92: Output Parameters:
93: + argc - the number of arguments
94: - args - the array of arguments
96: Level: intermediate
98: Concepts: command line arguments
99:
100: Notes: This may be called before PetscInitialize() or after PetscFinalize()
102: Not for use in Fortran
104: .seealso: PetscStrToArray()
106: @*/
107: PetscErrorCode PetscStrToArrayDestroy(int argc,char **args)
108: {
109: PetscInt i;
111: for (i=0; i<argc; i++) {
112: free(args[i]);
113: }
114: free(args);
115: return 0;
116: }
120: /*@C
121: PetscStrlen - Gets length of a string
123: Not Collective
125: Input Parameters:
126: . s - pointer to string
128: Output Parameter:
129: . len - length in bytes
131: Level: intermediate
133: Note:
134: This routine is analogous to strlen().
136: Null string returns a length of zero
138: Not for use in Fortran
140: Concepts: string length
141:
142: @*/
143: PetscErrorCode PetscStrlen(const char s[],size_t *len)
144: {
146: if (!s) {
147: *len = 0;
148: } else {
149: *len = strlen(s);
150: }
151: return(0);
152: }
156: /*@C
157: PetscStrallocpy - Allocates space to hold a copy of a string then copies the string
159: Not Collective
161: Input Parameters:
162: . s - pointer to string
164: Output Parameter:
165: . t - the copied string
167: Level: intermediate
169: Note:
170: Null string returns a new null string
172: Not for use in Fortran
174: Concepts: string copy
175:
176: @*/
177: PetscErrorCode PetscStrallocpy(const char s[],char *t[])
178: {
180: size_t len;
181: char *tmp = 0;
184: if (s) {
185: PetscStrlen(s,&len);
186: PetscMalloc((1+len)*sizeof(char),&tmp);
187: PetscStrcpy(tmp,s);
188: }
189: *t = tmp;
190: return(0);
191: }
195: /*@C
196: PetscStrcpy - Copies a string
198: Not Collective
200: Input Parameters:
201: . t - pointer to string
203: Output Parameter:
204: . s - the copied string
206: Level: intermediate
208: Notes:
209: Null string returns a string starting with zero
211: Not for use in Fortran
213: Concepts: string copy
214:
215: .seealso: PetscStrncpy(), PetscStrcat(), PetscStrncat()
217: @*/
219: PetscErrorCode PetscStrcpy(char s[],const char t[])
220: {
222: if (t && !s) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_NULL,"Trying to copy string into null pointer");
223: if (t) {strcpy(s,t);}
224: else if (s) {s[0] = 0;}
225: return(0);
226: }
230: /*@C
231: PetscStrncpy - Copies a string up to a certain length
233: Not Collective
235: Input Parameters:
236: + t - pointer to string
237: - n - the length to copy
239: Output Parameter:
240: . s - the copied string
242: Level: intermediate
244: Note:
245: Null string returns a string starting with zero
247: Concepts: string copy
249: .seealso: PetscStrcpy(), PetscStrcat(), PetscStrncat()
250:
251: @*/
252: PetscErrorCode PetscStrncpy(char s[],const char t[],size_t n)
253: {
255: if (t && !s) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_NULL,"Trying to copy string into null pointer");
256: if (t) {strncpy(s,t,n);}
257: else if (s) {s[0] = 0;}
258: return(0);
259: }
263: /*@C
264: PetscStrcat - Concatenates a string onto a given string
266: Not Collective
268: Input Parameters:
269: + s - string to be added to
270: - t - pointer to string to be added to end
272: Level: intermediate
274: Notes: Not for use in Fortran
276: Concepts: string copy
278: .seealso: PetscStrcpy(), PetscStrncpy(), PetscStrncat()
279:
280: @*/
281: PetscErrorCode PetscStrcat(char s[],const char t[])
282: {
284: if (!t) return(0);
285: strcat(s,t);
286: return(0);
287: }
291: /*@C
292: PetscStrncat - Concatenates a string onto a given string, up to a given length
294: Not Collective
296: Input Parameters:
297: + s - pointer to string to be added to end
298: . t - string to be added to
299: . n - maximum length to copy
301: Level: intermediate
303: Notes: Not for use in Fortran
305: Concepts: string copy
307: .seealso: PetscStrcpy(), PetscStrncpy(), PetscStrcat()
308:
309: @*/
310: PetscErrorCode PetscStrncat(char s[],const char t[],size_t n)
311: {
313: strncat(s,t,n);
314: return(0);
315: }
319: /*@C
320: PetscStrcmp - Compares two strings,
322: Not Collective
324: Input Parameters:
325: + a - pointer to string first string
326: - b - pointer to second string
328: Output Parameter:
329: . flg - if the two strings are equal
331: Level: intermediate
333: Notes: Not for use in Fortran
335: .seealso: PetscStrgrt(), PetscStrncmp(), PetscStrcasecmp()
337: @*/
338: PetscErrorCode PetscStrcmp(const char a[],const char b[],PetscBool *flg)
339: {
340: int c;
343: if (!a && !b) {
344: *flg = PETSC_TRUE;
345: } else if (!a || !b) {
346: *flg = PETSC_FALSE;
347: } else {
348: c = strcmp(a,b);
349: if (c) *flg = PETSC_FALSE;
350: else *flg = PETSC_TRUE;
351: }
352: return(0);
353: }
357: /*@C
358: PetscStrgrt - If first string is greater than the second
360: Not Collective
362: Input Parameters:
363: + a - pointer to first string
364: - b - pointer to second string
366: Output Parameter:
367: . flg - if the first string is greater
369: Notes:
370: Null arguments are ok, a null string is considered smaller than
371: all others
373: Not for use in Fortran
375: Level: intermediate
377: .seealso: PetscStrcmp(), PetscStrncmp(), PetscStrcasecmp()
379: @*/
380: PetscErrorCode PetscStrgrt(const char a[],const char b[],PetscBool *t)
381: {
382: int c;
385: if (!a && !b) {
386: *t = PETSC_FALSE;
387: } else if (a && !b) {
388: *t = PETSC_TRUE;
389: } else if (!a && b) {
390: *t = PETSC_FALSE;
391: } else {
392: c = strcmp(a,b);
393: if (c > 0) *t = PETSC_TRUE;
394: else *t = PETSC_FALSE;
395: }
396: return(0);
397: }
401: /*@C
402: PetscStrcasecmp - Returns true if the two strings are the same
403: except possibly for case.
405: Not Collective
407: Input Parameters:
408: + a - pointer to first string
409: - b - pointer to second string
411: Output Parameter:
412: . flg - if the two strings are the same
414: Notes:
415: Null arguments are ok
417: Not for use in Fortran
419: Level: intermediate
421: .seealso: PetscStrcmp(), PetscStrncmp(), PetscStrgrt()
423: @*/
424: PetscErrorCode PetscStrcasecmp(const char a[],const char b[],PetscBool *t)
425: {
426: int c;
429: if (!a && !b) c = 0;
430: else if (!a || !b) c = 1;
431: #if defined(PETSC_HAVE_STRCASECMP)
432: else c = strcasecmp(a,b);
433: #elif defined(PETSC_HAVE_STRICMP)
434: else c = stricmp(a,b);
435: #else
436: else {
437: char *aa,*bb;
439: PetscStrallocpy(a,&aa);
440: PetscStrallocpy(b,&bb);
441: PetscStrtolower(aa);
442: PetscStrtolower(bb);
443: PetscStrcmp(aa,bb,t);
444: PetscFree(aa);
445: PetscFree(bb);
446: return(0);
447: }
448: #endif
449: if (!c) *t = PETSC_TRUE;
450: else *t = PETSC_FALSE;
451: return(0);
452: }
458: /*@C
459: PetscStrncmp - Compares two strings, up to a certain length
461: Not Collective
463: Input Parameters:
464: + a - pointer to first string
465: . b - pointer to second string
466: - n - length to compare up to
468: Output Parameter:
469: . t - if the two strings are equal
471: Level: intermediate
473: Notes: Not for use in Fortran
475: .seealso: PetscStrgrt(), PetscStrcmp(), PetscStrcasecmp()
477: @*/
478: PetscErrorCode PetscStrncmp(const char a[],const char b[],size_t n,PetscBool *t)
479: {
480: int c;
483: c = strncmp(a,b,n);
484: if (!c) *t = PETSC_TRUE;
485: else *t = PETSC_FALSE;
486: return(0);
487: }
491: /*@C
492: PetscStrchr - Locates first occurance of a character in a string
494: Not Collective
496: Input Parameters:
497: + a - pointer to string
498: - b - character
500: Output Parameter:
501: . c - location of occurance, PETSC_NULL if not found
503: Level: intermediate
505: Notes: Not for use in Fortran
507: @*/
508: PetscErrorCode PetscStrchr(const char a[],char b,char *c[])
509: {
511: *c = (char *)strchr(a,b);
512: return(0);
513: }
517: /*@C
518: PetscStrrchr - Locates one location past the last occurance of a character in a string,
519: if the character is not found then returns entire string
521: Not Collective
523: Input Parameters:
524: + a - pointer to string
525: - b - character
527: Output Parameter:
528: . tmp - location of occurance, a if not found
530: Level: intermediate
532: Notes: Not for use in Fortran
534: @*/
535: PetscErrorCode PetscStrrchr(const char a[],char b,char *tmp[])
536: {
538: *tmp = (char *)strrchr(a,b);
539: if (!*tmp) *tmp = (char*)a; else *tmp = *tmp + 1;
540: return(0);
541: }
545: /*@C
546: PetscStrtolower - Converts string to lower case
548: Not Collective
550: Input Parameters:
551: . a - pointer to string
553: Level: intermediate
555: Notes: Not for use in Fortran
557: @*/
558: PetscErrorCode PetscStrtolower(char a[])
559: {
561: while (*a) {
562: if (*a >= 'A' && *a <= 'Z') *a += 'a' - 'A';
563: a++;
564: }
565: return(0);
566: }
570: /*@C
571: PetscStrendswith - Determines if a string ends with a certain string
573: Not Collective
575: Input Parameters:
576: + a - pointer to string
577: - b - string to endwith
579: Output Parameter:
580: . flg - PETSC_TRUE or PETSC_FALSE
582: Notes: Not for use in Fortran
584: Level: intermediate
586: @*/
587: PetscErrorCode PetscStrendswith(const char a[],const char b[],PetscBool *flg)
588: {
589: char *test;
591: size_t na,nb;
594: *flg = PETSC_FALSE;
595: PetscStrrstr(a,b,&test);
596: if (test) {
597: PetscStrlen(a,&na);
598: PetscStrlen(b,&nb);
599: if (a+na-nb == test) *flg = PETSC_TRUE;
600: }
601: return(0);
602: }
606: /*@C
607: PetscStrendswithwhich - Determines if a string ends with one of several possible strings
609: Not Collective
611: Input Parameters:
612: + a - pointer to string
613: - bs - strings to endwith (last entry must be null)
615: Output Parameter:
616: . cnt - the index of the string it ends with or 1+the last possible index
618: Notes: Not for use in Fortran
620: Level: intermediate
622: @*/
623: PetscErrorCode PetscStrendswithwhich(const char a[],const char *const *bs,PetscInt *cnt)
624: {
625: PetscBool flg;
629: *cnt = 0;
630: while (bs[*cnt]) {
631: PetscStrendswith(a,bs[*cnt],&flg);
632: if (flg) return(0);
633: *cnt += 1;
634: }
635: return(0);
636: }
640: /*@C
641: PetscStrrstr - Locates last occurance of string in another string
643: Not Collective
645: Input Parameters:
646: + a - pointer to string
647: - b - string to find
649: Output Parameter:
650: . tmp - location of occurance
652: Notes: Not for use in Fortran
654: Level: intermediate
656: @*/
657: PetscErrorCode PetscStrrstr(const char a[],const char b[],char *tmp[])
658: {
659: const char *stmp = a, *ltmp = 0;
662: while (stmp) {
663: stmp = (char *)strstr(stmp,b);
664: if (stmp) {ltmp = stmp;stmp++;}
665: }
666: *tmp = (char *)ltmp;
667: return(0);
668: }
672: /*@C
673: PetscStrstr - Locates first occurance of string in another string
675: Not Collective
677: Input Parameters:
678: + a - pointer to string
679: - b - string to find
681: Output Parameter:
682: . tmp - location of occurance, is a PETSC_NULL if the string is not found
684: Notes: Not for use in Fortran
686: Level: intermediate
688: @*/
689: PetscErrorCode PetscStrstr(const char a[],const char b[],char *tmp[])
690: {
692: *tmp = (char *)strstr(a,b);
693: return(0);
694: }
696: struct _p_PetscToken {char token;char *array;char *current;};
700: /*@C
701: PetscTokenFind - Locates next "token" in a string
703: Not Collective
705: Input Parameters:
706: . a - pointer to token
708: Output Parameter:
709: . result - location of occurance, PETSC_NULL if not found
711: Notes:
713: This version is different from the system version in that
714: it allows you to pass a read-only string into the function.
716: This version also treats all characters etc. inside a double quote "
717: as a single token.
719: Not for use in Fortran
721: Level: intermediate
724: .seealso: PetscTokenCreate(), PetscTokenDestroy()
725: @*/
726: PetscErrorCode PetscTokenFind(PetscToken a,char *result[])
727: {
728: char *ptr = a->current,token;
731: *result = a->current;
732: if (ptr && !*ptr) {*result = 0;return(0);}
733: token = a->token;
734: if (ptr && (*ptr == '"')) {token = '"';(*result)++;ptr++;}
735: while (ptr) {
736: if (*ptr == token) {
737: *ptr++ = 0;
738: while (*ptr == a->token) ptr++;
739: a->current = ptr;
740: break;
741: }
742: if (!*ptr) {
743: a->current = 0;
744: break;
745: }
746: ptr++;
747: }
748: return(0);
749: }
753: /*@C
754: PetscTokenCreate - Creates a PetscToken used to find tokens in a string
756: Not Collective
758: Input Parameters:
759: + string - the string to look in
760: - token - the character to look for
762: Output Parameter:
763: . a - pointer to token
765: Notes:
767: This version is different from the system version in that
768: it allows you to pass a read-only string into the function.
770: Not for use in Fortran
772: Level: intermediate
774: .seealso: PetscTokenFind(), PetscTokenDestroy()
775: @*/
776: PetscErrorCode PetscTokenCreate(const char a[],const char b,PetscToken *t)
777: {
781: PetscNew(struct _p_PetscToken,t);
782: PetscStrallocpy(a,&(*t)->array);
783: (*t)->current = (*t)->array;
784: (*t)->token = b;
785: return(0);
786: }
790: /*@C
791: PetscTokenDestroy - Destroys a PetscToken
793: Not Collective
795: Input Parameters:
796: . a - pointer to token
798: Level: intermediate
800: Notes: Not for use in Fortran
802: .seealso: PetscTokenCreate(), PetscTokenFind()
803: @*/
804: PetscErrorCode PetscTokenDestroy(PetscToken a)
805: {
809: PetscFree(a->array);
810: PetscFree(a);
811: return(0);
812: }
817: /*@C
818: PetscGetPetscDir - Gets the directory PETSc is installed in
820: Not Collective
822: Output Parameter:
823: . dir - the directory
825: Level: developer
827: Notes: Not for use in Fortran
829: @*/
830: PetscErrorCode PetscGetPetscDir(const char *dir[])
831: {
833: *dir = PETSC_DIR;
834: return(0);
835: }
839: /*@C
840: PetscStrreplace - Replaces substrings in string with other substrings
842: Not Collective
844: Input Parameters:
845: + comm - MPI_Comm of processors that are processing the string
846: . aa - the string to look in
847: . b - the resulting copy of a with replaced strings (b can be the same as a)
848: - len - the length of b
850: Notes:
851: Replaces ${PETSC_ARCH},${PETSC_DIR},${PETSC_LIB_DIR},${DISPLAY},
852: ${HOMEDIRECTORY},${WORKINGDIRECTORY},${USERNAME}, ${HOSTNAME} with appropriate values
853: as well as any environmental variables.
855: PETSC_LIB_DIR uses the environmental variable if it exists. PETSC_ARCH and PETSC_DIR use what
856: PETSc was built with and do not use environmental variables.
857:
858: Not for use in Fortran
859:
860: Level: intermediate
862: @*/
863: PetscErrorCode PetscStrreplace(MPI_Comm comm,const char aa[],char b[],size_t len)
864: {
866: int i = 0;
867: size_t l,l1,l2,l3;
868: char *work,*par,*epar,env[1024],*tfree,*a = (char*)aa;
869: const char *s[] = {"${PETSC_ARCH}","${PETSC_DIR}","${PETSC_LIB_DIR}","${DISPLAY}","${HOMEDIRECTORY}","${WORKINGDIRECTORY}","${USERNAME}","${HOSTNAME}",0};
870: const char *r[] = {0,0,0,0,0,0,0,0,0};
871: PetscBool flag;
874: if (!a || !b) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_NULL,"a and b strings must be nonnull");
875: if (aa == b) {
876: PetscStrallocpy(aa,(char **)&a);
877: }
878: PetscMalloc(len*sizeof(char*),&work);
880: /* get values for replaced variables */
881: PetscStrallocpy(PETSC_ARCH,(char**)&r[0]);
882: PetscStrallocpy(PETSC_DIR,(char**)&r[1]);
883: PetscStrallocpy(PETSC_LIB_DIR,(char**)&r[2]);
884: PetscMalloc(256*sizeof(char),&r[3]);
885: PetscMalloc(PETSC_MAX_PATH_LEN*sizeof(char),&r[4]);
886: PetscMalloc(PETSC_MAX_PATH_LEN*sizeof(char),&r[5]);
887: PetscMalloc(256*sizeof(char),&r[6]);
888: PetscMalloc(256*sizeof(char),&r[7]);
889: PetscGetDisplay((char*)r[3],256);
890: PetscGetHomeDirectory((char*)r[4],PETSC_MAX_PATH_LEN);
891: PetscGetWorkingDirectory((char*)r[5],PETSC_MAX_PATH_LEN);
892: PetscGetUserName((char*)r[6],256);
893: PetscGetHostName((char*)r[7],256);
895: /* replace that are in environment */
896: PetscOptionsGetenv(comm,"PETSC_LIB_DIR",env,1024,&flag);
897: if (flag) {
898: PetscStrallocpy(env,(char**)&r[2]);
899: }
901: /* replace the requested strings */
902: PetscStrncpy(b,a,len);
903: while (s[i]) {
904: PetscStrlen(s[i],&l);
905: PetscStrstr(b,s[i],&par);
906: while (par) {
907: *par = 0;
908: par += l;
910: PetscStrlen(b,&l1);
911: PetscStrlen(r[i],&l2);
912: PetscStrlen(par,&l3);
913: if (l1 + l2 + l3 >= len) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ,"b len is not long enough to hold new values");
914: PetscStrcpy(work,b);
915: PetscStrcat(work,r[i]);
916: PetscStrcat(work,par);
917: PetscStrncpy(b,work,len);
918: PetscStrstr(b,s[i],&par);
919: }
920: i++;
921: }
922: i = 0;
923: while (r[i]) {
924: tfree = (char*)r[i];
925: PetscFree(tfree);
926: i++;
927: }
929: /* look for any other ${xxx} strings to replace from environmental variables */
930: PetscStrstr(b,"${",&par);
931: while (par) {
932: *par = 0;
933: par += 2;
934: PetscStrcpy(work,b);
935: PetscStrstr(par,"}",&epar);
936: *epar = 0;
937: epar += 1;
938: PetscOptionsGetenv(comm,par,env,256,&flag);
939: if (!flag) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"Substitution string ${%s} not found as environmental variable",par);
940: PetscStrcat(work,env);
941: PetscStrcat(work,epar);
942: PetscStrcpy(b,work);
943: PetscStrstr(b,"${",&par);
944: }
945: PetscFree(work);
946: if (aa == b) {
947: PetscFree(a);
948: }
949: return(0);
950: }