Actual source code: str.c
petsc-3.6.4 2016-04-12
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> /* strstr */
11: #endif
12: #if defined(PETSC_HAVE_STRINGS_H)
13: # include <strings.h> /* strcasecmp */
14: #endif
18: /*@C
19: PetscStrToArray - Separates a string by a charactor (for example ' ' or '\n') and creates an array of strings
21: Not Collective
23: Input Parameters:
24: + s - pointer to string
25: - sp - separator charactor
27: Output Parameter:
28: + argc - the number of entries in the array
29: - args - an array of the entries with a null at the end
31: Level: intermediate
33: Notes: this may be called before PetscInitialize() or after PetscFinalize()
35: Not for use in Fortran
37: Developer Notes: Using raw malloc() and does not call error handlers since this may be used before PETSc is initialized. Used
38: to generate argc, args arguments passed to MPI_Init()
40: .seealso: PetscStrToArrayDestroy(), PetscToken, PetscTokenCreate()
42: @*/
43: PetscErrorCode PetscStrToArray(const char s[],char sp,int *argc,char ***args)
44: {
45: int i,n,*lens,cnt = 0;
46: PetscBool flg = PETSC_FALSE;
48: if (!s) n = 0;
49: else n = strlen(s);
50: *argc = 0;
51: if (!n) {
52: *args = 0;
53: return(0);
54: }
55: for (i=0; i<n; i++) {
56: if (s[i] != sp) break;
57: }
58: for (;i<n+1; i++) {
59: if ((s[i] == sp || s[i] == 0) && !flg) {flg = PETSC_TRUE; (*argc)++;}
60: else if (s[i] != sp) {flg = PETSC_FALSE;}
61: }
62: (*args) = (char**) malloc(((*argc)+1)*sizeof(char*)); if (!*args) return PETSC_ERR_MEM;
63: lens = (int*) malloc((*argc)*sizeof(int)); if (!lens) return PETSC_ERR_MEM;
64: for (i=0; i<*argc; i++) lens[i] = 0;
66: *argc = 0;
67: for (i=0; i<n; i++) {
68: if (s[i] != sp) break;
69: }
70: for (;i<n+1; i++) {
71: if ((s[i] == sp || s[i] == 0) && !flg) {flg = PETSC_TRUE; (*argc)++;}
72: else if (s[i] != sp) {lens[*argc]++;flg = PETSC_FALSE;}
73: }
75: for (i=0; i<*argc; i++) {
76: (*args)[i] = (char*) malloc((lens[i]+1)*sizeof(char)); if (!(*args)[i]) return PETSC_ERR_MEM;
77: }
78: free(lens);
79: (*args)[*argc] = 0;
81: *argc = 0;
82: for (i=0; i<n; i++) {
83: if (s[i] != sp) break;
84: }
85: for (;i<n+1; i++) {
86: if ((s[i] == sp || s[i] == 0) && !flg) {flg = PETSC_TRUE; (*args)[*argc][cnt++] = 0; (*argc)++; cnt = 0;}
87: else if (s[i] != sp && s[i] != 0) {(*args)[*argc][cnt++] = s[i]; flg = PETSC_FALSE;}
88: }
89: return 0;
90: }
94: /*@C
95: PetscStrToArrayDestroy - Frees array created with PetscStrToArray().
97: Not Collective
99: Output Parameters:
100: + argc - the number of arguments
101: - args - the array of arguments
103: Level: intermediate
105: Concepts: command line arguments
107: Notes: This may be called before PetscInitialize() or after PetscFinalize()
109: Not for use in Fortran
111: .seealso: PetscStrToArray()
113: @*/
114: PetscErrorCode PetscStrToArrayDestroy(int argc,char **args)
115: {
116: PetscInt i;
118: for (i=0; i<argc; i++) free(args[i]);
119: if (args) free(args);
120: return 0;
121: }
125: /*@C
126: PetscStrlen - Gets length of a string
128: Not Collective
130: Input Parameters:
131: . s - pointer to string
133: Output Parameter:
134: . len - length in bytes
136: Level: intermediate
138: Note:
139: This routine is analogous to strlen().
141: Null string returns a length of zero
143: Not for use in Fortran
145: Concepts: string length
147: @*/
148: PetscErrorCode PetscStrlen(const char s[],size_t *len)
149: {
151: if (!s) *len = 0;
152: else *len = strlen(s);
153: return(0);
154: }
158: /*@C
159: PetscStrallocpy - Allocates space to hold a copy of a string then copies the string
161: Not Collective
163: Input Parameters:
164: . s - pointer to string
166: Output Parameter:
167: . t - the copied string
169: Level: intermediate
171: Note:
172: Null string returns a new null string
174: Not for use in Fortran
176: Concepts: string copy
178: @*/
179: PetscErrorCode PetscStrallocpy(const char s[],char *t[])
180: {
182: size_t len;
183: char *tmp = 0;
186: if (s) {
187: PetscStrlen(s,&len);
188: PetscMalloc1(1+len,&tmp);
189: PetscStrcpy(tmp,s);
190: }
191: *t = tmp;
192: return(0);
193: }
197: /*@C
198: PetscStrArrayallocpy - Allocates space to hold a copy of an array of strings then copies the strings
200: Not Collective
202: Input Parameters:
203: . s - pointer to array of strings (final string is a null)
205: Output Parameter:
206: . t - the copied array string
208: Level: intermediate
210: Note:
211: Not for use in Fortran
213: Concepts: string copy
215: .seealso: PetscStrallocpy() PetscStrArrayDestroy()
217: @*/
218: PetscErrorCode PetscStrArrayallocpy(const char *const *list,char ***t)
219: {
221: PetscInt i,n = 0;
224: while (list[n++]) ;
225: PetscMalloc1(n+1,t);
226: for (i=0; i<n; i++) {
227: PetscStrallocpy(list[i],(*t)+i);
228: }
229: (*t)[n] = NULL;
230: return(0);
231: }
235: /*@C
236: PetscStrArrayDestroy - Frees array of strings created with PetscStrArrayallocpy().
238: Not Collective
240: Output Parameters:
241: . list - array of strings
243: Level: intermediate
245: Concepts: command line arguments
247: Notes: Not for use in Fortran
249: .seealso: PetscStrArrayallocpy()
251: @*/
252: PetscErrorCode PetscStrArrayDestroy(char ***list)
253: {
254: PetscInt n = 0;
258: if (!*list) return(0);
259: while ((*list)[n]) {
260: PetscFree((*list)[n]);
261: n++;
262: }
263: PetscFree(*list);
264: return(0);
265: }
269: /*@C
270: PetscStrNArrayallocpy - Allocates space to hold a copy of an array of strings then copies the strings
272: Not Collective
274: Input Parameters:
275: + n - the number of string entries
276: - s - pointer to array of strings
278: Output Parameter:
279: . t - the copied array string
281: Level: intermediate
283: Note:
284: Not for use in Fortran
286: Concepts: string copy
288: .seealso: PetscStrallocpy() PetscStrArrayDestroy()
290: @*/
291: PetscErrorCode PetscStrNArrayallocpy(PetscInt n,const char *const *list,char ***t)
292: {
294: PetscInt i;
297: PetscMalloc1(n,t);
298: for (i=0; i<n; i++) {
299: PetscStrallocpy(list[i],(*t)+i);
300: }
301: return(0);
302: }
306: /*@C
307: PetscStrNArrayDestroy - Frees array of strings created with PetscStrArrayallocpy().
309: Not Collective
311: Output Parameters:
312: + n - number of string entries
313: - list - array of strings
315: Level: intermediate
317: Notes: Not for use in Fortran
319: .seealso: PetscStrArrayallocpy()
321: @*/
322: PetscErrorCode PetscStrNArrayDestroy(PetscInt n,char ***list)
323: {
325: PetscInt i;
328: if (!*list) return(0);
329: for (i=0; i<n; i++){
330: PetscFree((*list)[i]);
331: }
332: PetscFree(*list);
333: return(0);
334: }
338: /*@C
339: PetscStrcpy - Copies a string
341: Not Collective
343: Input Parameters:
344: . t - pointer to string
346: Output Parameter:
347: . s - the copied string
349: Level: intermediate
351: Notes:
352: Null string returns a string starting with zero
354: Not for use in Fortran
356: Concepts: string copy
358: .seealso: PetscStrncpy(), PetscStrcat(), PetscStrncat()
360: @*/
362: PetscErrorCode PetscStrcpy(char s[],const char t[])
363: {
365: if (t && !s) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_NULL,"Trying to copy string into null pointer");
366: if (t) strcpy(s,t);
367: else if (s) s[0] = 0;
368: return(0);
369: }
373: /*@C
374: PetscStrncpy - Copies a string up to a certain length
376: Not Collective
378: Input Parameters:
379: + t - pointer to string
380: - n - the length to copy
382: Output Parameter:
383: . s - the copied string
385: Level: intermediate
387: Note:
388: Null string returns a string starting with zero
390: If the string that is being copied is of length n or larger then the entire string is not
391: copied and the file location of s is set to NULL. This is different then the behavior of
392: strncpy() which leaves s non-terminated.
394: Concepts: string copy
396: .seealso: PetscStrcpy(), PetscStrcat(), PetscStrncat()
398: @*/
399: PetscErrorCode PetscStrncpy(char s[],const char t[],size_t n)
400: {
402: if (t && !s) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_NULL,"Trying to copy string into null pointer");
403: if (t) {
404: if (n > 1) {
405: strncpy(s,t,n-1);
406: s[n-1] = '\0';
407: } else {
408: s[0] = '\0';
409: }
410: } else if (s) s[0] = 0;
411: return(0);
412: }
416: /*@C
417: PetscStrcat - Concatenates a string onto a given string
419: Not Collective
421: Input Parameters:
422: + s - string to be added to
423: - t - pointer to string to be added to end
425: Level: intermediate
427: Notes: Not for use in Fortran
429: Concepts: string copy
431: .seealso: PetscStrcpy(), PetscStrncpy(), PetscStrncat()
433: @*/
434: PetscErrorCode PetscStrcat(char s[],const char t[])
435: {
437: if (!t) return(0);
438: strcat(s,t);
439: return(0);
440: }
444: /*@C
445: PetscStrncat - Concatenates a string onto a given string, up to a given length
447: Not Collective
449: Input Parameters:
450: + s - pointer to string to be added to end
451: . t - string to be added to
452: . n - maximum length to copy
454: Level: intermediate
456: Notes: Not for use in Fortran
458: Concepts: string copy
460: .seealso: PetscStrcpy(), PetscStrncpy(), PetscStrcat()
462: @*/
463: PetscErrorCode PetscStrncat(char s[],const char t[],size_t n)
464: {
466: strncat(s,t,n);
467: return(0);
468: }
472: /*
475: Will be removed once we eliminate the __FUNCT__ paradigm
476: */
477: void PetscStrcmpNoError(const char a[],const char b[],PetscBool *flg)
478: {
479: int c;
481: if (!a && !b) *flg = PETSC_TRUE;
482: else if (!a || !b) *flg = PETSC_FALSE;
483: else {
484: c = strcmp(a,b);
485: if (c) *flg = PETSC_FALSE;
486: else *flg = PETSC_TRUE;
487: }
488: }
492: /*@C
493: PetscStrcmp - Compares two strings,
495: Not Collective
497: Input Parameters:
498: + a - pointer to string first string
499: - b - pointer to second string
501: Output Parameter:
502: . flg - PETSC_TRUE if the two strings are equal
504: Level: intermediate
506: Notes: Not for use in Fortran
508: .seealso: PetscStrgrt(), PetscStrncmp(), PetscStrcasecmp()
510: @*/
511: PetscErrorCode PetscStrcmp(const char a[],const char b[],PetscBool *flg)
512: {
513: int c;
516: if (!a && !b) *flg = PETSC_TRUE;
517: else if (!a || !b) *flg = PETSC_FALSE;
518: else {
519: c = strcmp(a,b);
520: if (c) *flg = PETSC_FALSE;
521: else *flg = PETSC_TRUE;
522: }
523: return(0);
524: }
528: /*@C
529: PetscStrgrt - If first string is greater than the second
531: Not Collective
533: Input Parameters:
534: + a - pointer to first string
535: - b - pointer to second string
537: Output Parameter:
538: . flg - if the first string is greater
540: Notes:
541: Null arguments are ok, a null string is considered smaller than
542: all others
544: Not for use in Fortran
546: Level: intermediate
548: .seealso: PetscStrcmp(), PetscStrncmp(), PetscStrcasecmp()
550: @*/
551: PetscErrorCode PetscStrgrt(const char a[],const char b[],PetscBool *t)
552: {
553: int c;
556: if (!a && !b) *t = PETSC_FALSE;
557: else if (a && !b) *t = PETSC_TRUE;
558: else if (!a && b) *t = PETSC_FALSE;
559: else {
560: c = strcmp(a,b);
561: if (c > 0) *t = PETSC_TRUE;
562: else *t = PETSC_FALSE;
563: }
564: return(0);
565: }
569: /*@C
570: PetscStrcasecmp - Returns true if the two strings are the same
571: except possibly for case.
573: Not Collective
575: Input Parameters:
576: + a - pointer to first string
577: - b - pointer to second string
579: Output Parameter:
580: . flg - if the two strings are the same
582: Notes:
583: Null arguments are ok
585: Not for use in Fortran
587: Level: intermediate
589: .seealso: PetscStrcmp(), PetscStrncmp(), PetscStrgrt()
591: @*/
592: PetscErrorCode PetscStrcasecmp(const char a[],const char b[],PetscBool *t)
593: {
594: int c;
597: if (!a && !b) c = 0;
598: else if (!a || !b) c = 1;
599: #if defined(PETSC_HAVE_STRCASECMP)
600: else c = strcasecmp(a,b);
601: #elif defined(PETSC_HAVE_STRICMP)
602: else c = stricmp(a,b);
603: #else
604: else {
605: char *aa,*bb;
607: PetscStrallocpy(a,&aa);
608: PetscStrallocpy(b,&bb);
609: PetscStrtolower(aa);
610: PetscStrtolower(bb);
611: PetscStrcmp(aa,bb,t);
612: PetscFree(aa);
613: PetscFree(bb);
614: return(0);
615: }
616: #endif
617: if (!c) *t = PETSC_TRUE;
618: else *t = PETSC_FALSE;
619: return(0);
620: }
626: /*@C
627: PetscStrncmp - Compares two strings, up to a certain length
629: Not Collective
631: Input Parameters:
632: + a - pointer to first string
633: . b - pointer to second string
634: - n - length to compare up to
636: Output Parameter:
637: . t - if the two strings are equal
639: Level: intermediate
641: Notes: Not for use in Fortran
643: .seealso: PetscStrgrt(), PetscStrcmp(), PetscStrcasecmp()
645: @*/
646: PetscErrorCode PetscStrncmp(const char a[],const char b[],size_t n,PetscBool *t)
647: {
648: int c;
651: c = strncmp(a,b,n);
652: if (!c) *t = PETSC_TRUE;
653: else *t = PETSC_FALSE;
654: return(0);
655: }
659: /*@C
660: PetscStrchr - Locates first occurance of a character in a string
662: Not Collective
664: Input Parameters:
665: + a - pointer to string
666: - b - character
668: Output Parameter:
669: . c - location of occurance, NULL if not found
671: Level: intermediate
673: Notes: Not for use in Fortran
675: @*/
676: PetscErrorCode PetscStrchr(const char a[],char b,char *c[])
677: {
679: *c = (char*)strchr(a,b);
680: return(0);
681: }
685: /*@C
686: PetscStrrchr - Locates one location past the last occurance of a character in a string,
687: if the character is not found then returns entire string
689: Not Collective
691: Input Parameters:
692: + a - pointer to string
693: - b - character
695: Output Parameter:
696: . tmp - location of occurance, a if not found
698: Level: intermediate
700: Notes: Not for use in Fortran
702: @*/
703: PetscErrorCode PetscStrrchr(const char a[],char b,char *tmp[])
704: {
706: *tmp = (char*)strrchr(a,b);
707: if (!*tmp) *tmp = (char*)a;
708: else *tmp = *tmp + 1;
709: return(0);
710: }
714: /*@C
715: PetscStrtolower - Converts string to lower case
717: Not Collective
719: Input Parameters:
720: . a - pointer to string
722: Level: intermediate
724: Notes: Not for use in Fortran
726: @*/
727: PetscErrorCode PetscStrtolower(char a[])
728: {
730: while (*a) {
731: if (*a >= 'A' && *a <= 'Z') *a += 'a' - 'A';
732: a++;
733: }
734: return(0);
735: }
739: /*@C
740: PetscStrtolower - Converts string to upper case
742: Not Collective
744: Input Parameters:
745: . a - pointer to string
747: Level: intermediate
749: Notes: Not for use in Fortran
751: @*/
752: PetscErrorCode PetscStrtoupper(char a[])
753: {
755: while (*a) {
756: if (*a >= 'a' && *a <= 'z') *a += 'A' - 'a';
757: a++;
758: }
759: return(0);
760: }
764: /*@C
765: PetscStrendswith - Determines if a string ends with a certain string
767: Not Collective
769: Input Parameters:
770: + a - pointer to string
771: - b - string to endwith
773: Output Parameter:
774: . flg - PETSC_TRUE or PETSC_FALSE
776: Notes: Not for use in Fortran
778: Level: intermediate
780: @*/
781: PetscErrorCode PetscStrendswith(const char a[],const char b[],PetscBool *flg)
782: {
783: char *test;
785: size_t na,nb;
788: *flg = PETSC_FALSE;
789: PetscStrrstr(a,b,&test);
790: if (test) {
791: PetscStrlen(a,&na);
792: PetscStrlen(b,&nb);
793: if (a+na-nb == test) *flg = PETSC_TRUE;
794: }
795: return(0);
796: }
800: /*@C
801: PetscStrbeginswith - Determines if a string begins with a certain string
803: Not Collective
805: Input Parameters:
806: + a - pointer to string
807: - b - string to beginwith
809: Output Parameter:
810: . flg - PETSC_TRUE or PETSC_FALSE
812: Notes: Not for use in Fortran
814: Level: intermediate
816: @*/
817: PetscErrorCode PetscStrbeginswith(const char a[],const char b[],PetscBool *flg)
818: {
819: char *test;
823: *flg = PETSC_FALSE;
824: PetscStrrstr(a,b,&test);
825: if (test && (test == a)) *flg = PETSC_TRUE;
826: return(0);
827: }
832: /*@C
833: PetscStrendswithwhich - Determines if a string ends with one of several possible strings
835: Not Collective
837: Input Parameters:
838: + a - pointer to string
839: - bs - strings to endwith (last entry must be null)
841: Output Parameter:
842: . cnt - the index of the string it ends with or 1+the last possible index
844: Notes: Not for use in Fortran
846: Level: intermediate
848: @*/
849: PetscErrorCode PetscStrendswithwhich(const char a[],const char *const *bs,PetscInt *cnt)
850: {
851: PetscBool flg;
855: *cnt = 0;
856: while (bs[*cnt]) {
857: PetscStrendswith(a,bs[*cnt],&flg);
858: if (flg) return(0);
859: *cnt += 1;
860: }
861: return(0);
862: }
866: /*@C
867: PetscStrrstr - Locates last occurance of string in another string
869: Not Collective
871: Input Parameters:
872: + a - pointer to string
873: - b - string to find
875: Output Parameter:
876: . tmp - location of occurance
878: Notes: Not for use in Fortran
880: Level: intermediate
882: @*/
883: PetscErrorCode PetscStrrstr(const char a[],const char b[],char *tmp[])
884: {
885: const char *stmp = a, *ltmp = 0;
888: while (stmp) {
889: stmp = (char*)strstr(stmp,b);
890: if (stmp) {ltmp = stmp;stmp++;}
891: }
892: *tmp = (char*)ltmp;
893: return(0);
894: }
898: /*@C
899: PetscStrstr - Locates first occurance of string in another string
901: Not Collective
903: Input Parameters:
904: + haystack - string to search
905: - needle - string to find
907: Output Parameter:
908: . tmp - location of occurance, is a NULL if the string is not found
910: Notes: Not for use in Fortran
912: Level: intermediate
914: @*/
915: PetscErrorCode PetscStrstr(const char haystack[],const char needle[],char *tmp[])
916: {
918: *tmp = (char*)strstr(haystack,needle);
919: return(0);
920: }
922: struct _p_PetscToken {char token;char *array;char *current;};
926: /*@C
927: PetscTokenFind - Locates next "token" in a string
929: Not Collective
931: Input Parameters:
932: . a - pointer to token
934: Output Parameter:
935: . result - location of occurance, NULL if not found
937: Notes:
939: This version is different from the system version in that
940: it allows you to pass a read-only string into the function.
942: This version also treats all characters etc. inside a double quote "
943: as a single token.
945: For example if the separator character is + and the string is xxxx+y then the first fine will return a pointer to a null terminated xxxx and the
946: second will return a null terminated y
948: If the separator character is + and the string is xxxx then the first and only token found will be a pointer to a null terminated xxxx
950: Not for use in Fortran
952: Level: intermediate
955: .seealso: PetscTokenCreate(), PetscTokenDestroy()
956: @*/
957: PetscErrorCode PetscTokenFind(PetscToken a,char *result[])
958: {
959: char *ptr = a->current,token;
962: *result = a->current;
963: if (ptr && !*ptr) {*result = 0;return(0);}
964: token = a->token;
965: if (ptr && (*ptr == '"')) {token = '"';(*result)++;ptr++;}
966: while (ptr) {
967: if (*ptr == token) {
968: *ptr++ = 0;
969: while (*ptr == a->token) ptr++;
970: a->current = ptr;
971: break;
972: }
973: if (!*ptr) {
974: a->current = 0;
975: break;
976: }
977: ptr++;
978: }
979: return(0);
980: }
984: /*@C
985: PetscTokenCreate - Creates a PetscToken used to find tokens in a string
987: Not Collective
989: Input Parameters:
990: + string - the string to look in
991: - b - the separator character
993: Output Parameter:
994: . t- the token object
996: Notes:
998: This version is different from the system version in that
999: it allows you to pass a read-only string into the function.
1001: Not for use in Fortran
1003: Level: intermediate
1005: .seealso: PetscTokenFind(), PetscTokenDestroy()
1006: @*/
1007: PetscErrorCode PetscTokenCreate(const char a[],const char b,PetscToken *t)
1008: {
1012: PetscNew(t);
1013: PetscStrallocpy(a,&(*t)->array);
1015: (*t)->current = (*t)->array;
1016: (*t)->token = b;
1017: return(0);
1018: }
1022: /*@C
1023: PetscTokenDestroy - Destroys a PetscToken
1025: Not Collective
1027: Input Parameters:
1028: . a - pointer to token
1030: Level: intermediate
1032: Notes: Not for use in Fortran
1034: .seealso: PetscTokenCreate(), PetscTokenFind()
1035: @*/
1036: PetscErrorCode PetscTokenDestroy(PetscToken *a)
1037: {
1041: if (!*a) return(0);
1042: PetscFree((*a)->array);
1043: PetscFree(*a);
1044: return(0);
1045: }
1050: /*@C
1051: PetscGetPetscDir - Gets the directory PETSc is installed in
1053: Not Collective
1055: Output Parameter:
1056: . dir - the directory
1058: Level: developer
1060: Notes: Not for use in Fortran
1062: @*/
1063: PetscErrorCode PetscGetPetscDir(const char *dir[])
1064: {
1066: *dir = PETSC_DIR;
1067: return(0);
1068: }
1072: /*@C
1073: PetscStrreplace - Replaces substrings in string with other substrings
1075: Not Collective
1077: Input Parameters:
1078: + comm - MPI_Comm of processors that are processing the string
1079: . aa - the string to look in
1080: . b - the resulting copy of a with replaced strings (b can be the same as a)
1081: - len - the length of b
1083: Notes:
1084: Replaces ${PETSC_ARCH},${PETSC_DIR},${PETSC_LIB_DIR},${DISPLAY},
1085: ${HOMEDIRECTORY},${WORKINGDIRECTORY},${USERNAME}, ${HOSTNAME} with appropriate values
1086: as well as any environmental variables.
1088: PETSC_LIB_DIR uses the environmental variable if it exists. PETSC_ARCH and PETSC_DIR use what
1089: PETSc was built with and do not use environmental variables.
1091: Not for use in Fortran
1093: Level: intermediate
1095: @*/
1096: PetscErrorCode PetscStrreplace(MPI_Comm comm,const char aa[],char b[],size_t len)
1097: {
1099: int i = 0;
1100: size_t l,l1,l2,l3;
1101: char *work,*par,*epar,env[1024],*tfree,*a = (char*)aa;
1102: const char *s[] = {"${PETSC_ARCH}","${PETSC_DIR}","${PETSC_LIB_DIR}","${DISPLAY}","${HOMEDIRECTORY}","${WORKINGDIRECTORY}","${USERNAME}","${HOSTNAME}",0};
1103: const char *r[] = {0,0,0,0,0,0,0,0,0};
1104: PetscBool flag;
1107: if (!a || !b) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_NULL,"a and b strings must be nonnull");
1108: if (aa == b) {
1109: PetscStrallocpy(aa,(char**)&a);
1110: }
1111: PetscMalloc1(len,&work);
1113: /* get values for replaced variables */
1114: PetscStrallocpy(PETSC_ARCH,(char**)&r[0]);
1115: PetscStrallocpy(PETSC_DIR,(char**)&r[1]);
1116: PetscStrallocpy(PETSC_LIB_DIR,(char**)&r[2]);
1117: PetscMalloc1(256,&r[3]);
1118: PetscMalloc1(PETSC_MAX_PATH_LEN,&r[4]);
1119: PetscMalloc1(PETSC_MAX_PATH_LEN,&r[5]);
1120: PetscMalloc1(256,&r[6]);
1121: PetscMalloc1(256,&r[7]);
1122: PetscGetDisplay((char*)r[3],256);
1123: PetscGetHomeDirectory((char*)r[4],PETSC_MAX_PATH_LEN);
1124: PetscGetWorkingDirectory((char*)r[5],PETSC_MAX_PATH_LEN);
1125: PetscGetUserName((char*)r[6],256);
1126: PetscGetHostName((char*)r[7],256);
1128: /* replace that are in environment */
1129: PetscOptionsGetenv(comm,"PETSC_LIB_DIR",env,1024,&flag);
1130: if (flag) {
1131: PetscFree(r[2]);
1132: PetscStrallocpy(env,(char**)&r[2]);
1133: }
1135: /* replace the requested strings */
1136: PetscStrncpy(b,a,len);
1137: while (s[i]) {
1138: PetscStrlen(s[i],&l);
1139: PetscStrstr(b,s[i],&par);
1140: while (par) {
1141: *par = 0;
1142: par += l;
1144: PetscStrlen(b,&l1);
1145: PetscStrlen(r[i],&l2);
1146: PetscStrlen(par,&l3);
1147: if (l1 + l2 + l3 >= len) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ,"b len is not long enough to hold new values");
1148: PetscStrcpy(work,b);
1149: PetscStrcat(work,r[i]);
1150: PetscStrcat(work,par);
1151: PetscStrncpy(b,work,len);
1152: PetscStrstr(b,s[i],&par);
1153: }
1154: i++;
1155: }
1156: i = 0;
1157: while (r[i]) {
1158: tfree = (char*)r[i];
1159: PetscFree(tfree);
1160: i++;
1161: }
1163: /* look for any other ${xxx} strings to replace from environmental variables */
1164: PetscStrstr(b,"${",&par);
1165: while (par) {
1166: *par = 0;
1167: par += 2;
1168: PetscStrcpy(work,b);
1169: PetscStrstr(par,"}",&epar);
1170: *epar = 0;
1171: epar += 1;
1172: PetscOptionsGetenv(comm,par,env,256,&flag);
1173: if (!flag) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"Substitution string ${%s} not found as environmental variable",par);
1174: PetscStrcat(work,env);
1175: PetscStrcat(work,epar);
1176: PetscStrcpy(b,work);
1177: PetscStrstr(b,"${",&par);
1178: }
1179: PetscFree(work);
1180: if (aa == b) {
1181: PetscFree(a);
1182: }
1183: return(0);
1184: }
1188: /*@C
1189: PetscEListFind - searches list of strings for given string, using case insensitive matching
1191: Not Collective
1193: Input Parameters:
1194: + n - number of strings in
1195: . list - list of strings to search
1196: - str - string to look for, empty string "" accepts default (first entry in list)
1198: Output Parameters:
1199: + value - index of matching string (if found)
1200: - found - boolean indicating whether string was found (can be NULL)
1202: Notes:
1203: Not for use in Fortran
1205: Level: advanced
1206: @*/
1207: PetscErrorCode PetscEListFind(PetscInt n,const char *const *list,const char *str,PetscInt *value,PetscBool *found)
1208: {
1210: PetscBool matched;
1211: PetscInt i;
1214: if (found) *found = PETSC_FALSE;
1215: for (i=0; i<n; i++) {
1216: PetscStrcasecmp(str,list[i],&matched);
1217: if (matched || !str[0]) {
1218: if (found) *found = PETSC_TRUE;
1219: *value = i;
1220: break;
1221: }
1222: }
1223: return(0);
1224: }
1228: /*@C
1229: PetscEListFind - searches enum list of strings for given string, using case insensitive matching
1231: Not Collective
1233: Input Parameters:
1234: + enumlist - list of strings to search, followed by enum name, then enum prefix, then NUL
1235: - str - string to look for
1237: Output Parameters:
1238: + value - index of matching string (if found)
1239: - found - boolean indicating whether string was found (can be NULL)
1241: Notes:
1242: Not for use in Fortran
1244: Level: advanced
1245: @*/
1246: PetscErrorCode PetscEnumFind(const char *const *enumlist,const char *str,PetscEnum *value,PetscBool *found)
1247: {
1249: PetscInt n = 0,evalue;
1250: PetscBool efound;
1253: while (enumlist[n++]) if (n > 50) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"List argument appears to be wrong or have more than 50 entries");
1254: if (n < 3) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"List argument must have at least two entries: typename and type prefix");
1255: n -= 3; /* drop enum name, prefix, and null termination */
1256: PetscEListFind(n,enumlist,str,&evalue,&efound);
1257: if (efound) *value = (PetscEnum)evalue;
1258: if (found) *found = efound;
1259: return(0);
1260: }