Actual source code: str.c
petsc-3.7.7 2017-09-25
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,j,n,*lens,cnt = 0;
46: PetscBool flg = PETSC_FALSE;
48: if (!s) n = 0;
49: else n = strlen(s);
50: *argc = 0;
51: *args = NULL;
52: if (!n) {
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: if (!*argc) { /* string only has separator characters */
63: return(0);
64: }
65: (*args) = (char**) malloc(((*argc)+1)*sizeof(char*)); if (!*args) return PETSC_ERR_MEM;
66: lens = (int*) malloc((*argc)*sizeof(int)); if (!lens) return PETSC_ERR_MEM;
67: for (i=0; i<*argc; i++) lens[i] = 0;
69: *argc = 0;
70: for (i=0; i<n; i++) {
71: if (s[i] != sp) break;
72: }
73: for (;i<n+1; i++) {
74: if ((s[i] == sp || s[i] == 0) && !flg) {flg = PETSC_TRUE; (*argc)++;}
75: else if (s[i] != sp) {lens[*argc]++;flg = PETSC_FALSE;}
76: }
78: for (i=0; i<*argc; i++) {
79: (*args)[i] = (char*) malloc((lens[i]+1)*sizeof(char));
80: if (!(*args)[i]) {
81: free(lens);
82: for (j=0; j<i; j++) free((*args)[j]);
83: free(*args);
84: return PETSC_ERR_MEM;
85: }
86: }
87: free(lens);
88: (*args)[*argc] = 0;
90: *argc = 0;
91: for (i=0; i<n; i++) {
92: if (s[i] != sp) break;
93: }
94: for (;i<n+1; i++) {
95: if ((s[i] == sp || s[i] == 0) && !flg) {flg = PETSC_TRUE; (*args)[*argc][cnt++] = 0; (*argc)++; cnt = 0;}
96: else if (s[i] != sp && s[i] != 0) {(*args)[*argc][cnt++] = s[i]; flg = PETSC_FALSE;}
97: }
98: return 0;
99: }
103: /*@C
104: PetscStrToArrayDestroy - Frees array created with PetscStrToArray().
106: Not Collective
108: Output Parameters:
109: + argc - the number of arguments
110: - args - the array of arguments
112: Level: intermediate
114: Concepts: command line arguments
116: Notes: This may be called before PetscInitialize() or after PetscFinalize()
118: Not for use in Fortran
120: .seealso: PetscStrToArray()
122: @*/
123: PetscErrorCode PetscStrToArrayDestroy(int argc,char **args)
124: {
125: PetscInt i;
127: for (i=0; i<argc; i++) free(args[i]);
128: if (args) free(args);
129: return 0;
130: }
134: /*@C
135: PetscStrlen - Gets length of a string
137: Not Collective
139: Input Parameters:
140: . s - pointer to string
142: Output Parameter:
143: . len - length in bytes
145: Level: intermediate
147: Note:
148: This routine is analogous to strlen().
150: Null string returns a length of zero
152: Not for use in Fortran
154: Concepts: string length
156: @*/
157: PetscErrorCode PetscStrlen(const char s[],size_t *len)
158: {
160: if (!s) *len = 0;
161: else *len = strlen(s);
162: return(0);
163: }
167: /*@C
168: PetscStrallocpy - Allocates space to hold a copy of a string then copies the string
170: Not Collective
172: Input Parameters:
173: . s - pointer to string
175: Output Parameter:
176: . t - the copied string
178: Level: intermediate
180: Note:
181: Null string returns a new null string
183: Not for use in Fortran
185: Concepts: string copy
187: @*/
188: PetscErrorCode PetscStrallocpy(const char s[],char *t[])
189: {
191: size_t len;
192: char *tmp = 0;
195: if (s) {
196: PetscStrlen(s,&len);
197: PetscMalloc1(1+len,&tmp);
198: PetscStrcpy(tmp,s);
199: }
200: *t = tmp;
201: return(0);
202: }
206: /*@C
207: PetscStrArrayallocpy - Allocates space to hold a copy of an array of strings then copies the strings
209: Not Collective
211: Input Parameters:
212: . s - pointer to array of strings (final string is a null)
214: Output Parameter:
215: . t - the copied array string
217: Level: intermediate
219: Note:
220: Not for use in Fortran
222: Concepts: string copy
224: .seealso: PetscStrallocpy() PetscStrArrayDestroy()
226: @*/
227: PetscErrorCode PetscStrArrayallocpy(const char *const *list,char ***t)
228: {
230: PetscInt i,n = 0;
233: while (list[n++]) ;
234: PetscMalloc1(n+1,t);
235: for (i=0; i<n; i++) {
236: PetscStrallocpy(list[i],(*t)+i);
237: }
238: (*t)[n] = NULL;
239: return(0);
240: }
244: /*@C
245: PetscStrArrayDestroy - Frees array of strings created with PetscStrArrayallocpy().
247: Not Collective
249: Output Parameters:
250: . list - array of strings
252: Level: intermediate
254: Concepts: command line arguments
256: Notes: Not for use in Fortran
258: .seealso: PetscStrArrayallocpy()
260: @*/
261: PetscErrorCode PetscStrArrayDestroy(char ***list)
262: {
263: PetscInt n = 0;
267: if (!*list) return(0);
268: while ((*list)[n]) {
269: PetscFree((*list)[n]);
270: n++;
271: }
272: PetscFree(*list);
273: return(0);
274: }
278: /*@C
279: PetscStrNArrayallocpy - Allocates space to hold a copy of an array of strings then copies the strings
281: Not Collective
283: Input Parameters:
284: + n - the number of string entries
285: - s - pointer to array of strings
287: Output Parameter:
288: . t - the copied array string
290: Level: intermediate
292: Note:
293: Not for use in Fortran
295: Concepts: string copy
297: .seealso: PetscStrallocpy() PetscStrArrayDestroy()
299: @*/
300: PetscErrorCode PetscStrNArrayallocpy(PetscInt n,const char *const *list,char ***t)
301: {
303: PetscInt i;
306: PetscMalloc1(n,t);
307: for (i=0; i<n; i++) {
308: PetscStrallocpy(list[i],(*t)+i);
309: }
310: return(0);
311: }
315: /*@C
316: PetscStrNArrayDestroy - Frees array of strings created with PetscStrArrayallocpy().
318: Not Collective
320: Output Parameters:
321: + n - number of string entries
322: - list - array of strings
324: Level: intermediate
326: Notes: Not for use in Fortran
328: .seealso: PetscStrArrayallocpy()
330: @*/
331: PetscErrorCode PetscStrNArrayDestroy(PetscInt n,char ***list)
332: {
334: PetscInt i;
337: if (!*list) return(0);
338: for (i=0; i<n; i++){
339: PetscFree((*list)[i]);
340: }
341: PetscFree(*list);
342: return(0);
343: }
347: /*@C
348: PetscStrcpy - Copies a string
350: Not Collective
352: Input Parameters:
353: . t - pointer to string
355: Output Parameter:
356: . s - the copied string
358: Level: intermediate
360: Notes:
361: Null string returns a string starting with zero
363: Not for use in Fortran
365: Concepts: string copy
367: .seealso: PetscStrncpy(), PetscStrcat(), PetscStrncat()
369: @*/
371: PetscErrorCode PetscStrcpy(char s[],const char t[])
372: {
374: if (t && !s) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_NULL,"Trying to copy string into null pointer");
375: if (t) strcpy(s,t);
376: else if (s) s[0] = 0;
377: return(0);
378: }
382: /*@C
383: PetscStrncpy - Copies a string up to a certain length
385: Not Collective
387: Input Parameters:
388: + t - pointer to string
389: - n - the length to copy
391: Output Parameter:
392: . s - the copied string
394: Level: intermediate
396: Note:
397: Null string returns a string starting with zero
399: If the string that is being copied is of length n or larger then the entire string is not
400: copied and the file location of s is set to NULL. This is different then the behavior of
401: strncpy() which leaves s non-terminated.
403: Concepts: string copy
405: .seealso: PetscStrcpy(), PetscStrcat(), PetscStrncat()
407: @*/
408: PetscErrorCode PetscStrncpy(char s[],const char t[],size_t n)
409: {
411: if (t && !s) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_NULL,"Trying to copy string into null pointer");
412: if (t) {
413: if (n > 1) {
414: strncpy(s,t,n-1);
415: s[n-1] = '\0';
416: } else {
417: s[0] = '\0';
418: }
419: } else if (s) s[0] = 0;
420: return(0);
421: }
425: /*@C
426: PetscStrcat - Concatenates a string onto a given string
428: Not Collective
430: Input Parameters:
431: + s - string to be added to
432: - t - pointer to string to be added to end
434: Level: intermediate
436: Notes: Not for use in Fortran
438: Concepts: string copy
440: .seealso: PetscStrcpy(), PetscStrncpy(), PetscStrncat()
442: @*/
443: PetscErrorCode PetscStrcat(char s[],const char t[])
444: {
446: if (!t) return(0);
447: strcat(s,t);
448: return(0);
449: }
453: /*@C
454: PetscStrncat - Concatenates a string onto a given string, up to a given length
456: Not Collective
458: Input Parameters:
459: + s - pointer to string to be added to end
460: . t - string to be added to
461: . n - maximum length to copy
463: Level: intermediate
465: Notes: Not for use in Fortran
467: Concepts: string copy
469: .seealso: PetscStrcpy(), PetscStrncpy(), PetscStrcat()
471: @*/
472: PetscErrorCode PetscStrncat(char s[],const char t[],size_t n)
473: {
475: strncat(s,t,n);
476: return(0);
477: }
481: /*
484: Will be removed once we eliminate the __FUNCT__ paradigm
485: */
486: void PetscStrcmpNoError(const char a[],const char b[],PetscBool *flg)
487: {
488: int c;
490: if (!a && !b) *flg = PETSC_TRUE;
491: else if (!a || !b) *flg = PETSC_FALSE;
492: else {
493: c = strcmp(a,b);
494: if (c) *flg = PETSC_FALSE;
495: else *flg = PETSC_TRUE;
496: }
497: }
501: /*@C
502: PetscStrcmp - Compares two strings,
504: Not Collective
506: Input Parameters:
507: + a - pointer to string first string
508: - b - pointer to second string
510: Output Parameter:
511: . flg - PETSC_TRUE if the two strings are equal
513: Level: intermediate
515: Notes: Not for use in Fortran
517: .seealso: PetscStrgrt(), PetscStrncmp(), PetscStrcasecmp()
519: @*/
520: PetscErrorCode PetscStrcmp(const char a[],const char b[],PetscBool *flg)
521: {
522: int c;
525: if (!a && !b) *flg = PETSC_TRUE;
526: else if (!a || !b) *flg = PETSC_FALSE;
527: else {
528: c = strcmp(a,b);
529: if (c) *flg = PETSC_FALSE;
530: else *flg = PETSC_TRUE;
531: }
532: return(0);
533: }
537: /*@C
538: PetscStrgrt - If first string is greater than the second
540: Not Collective
542: Input Parameters:
543: + a - pointer to first string
544: - b - pointer to second string
546: Output Parameter:
547: . flg - if the first string is greater
549: Notes:
550: Null arguments are ok, a null string is considered smaller than
551: all others
553: Not for use in Fortran
555: Level: intermediate
557: .seealso: PetscStrcmp(), PetscStrncmp(), PetscStrcasecmp()
559: @*/
560: PetscErrorCode PetscStrgrt(const char a[],const char b[],PetscBool *t)
561: {
562: int c;
565: if (!a && !b) *t = PETSC_FALSE;
566: else if (a && !b) *t = PETSC_TRUE;
567: else if (!a && b) *t = PETSC_FALSE;
568: else {
569: c = strcmp(a,b);
570: if (c > 0) *t = PETSC_TRUE;
571: else *t = PETSC_FALSE;
572: }
573: return(0);
574: }
578: /*@C
579: PetscStrcasecmp - Returns true if the two strings are the same
580: except possibly for case.
582: Not Collective
584: Input Parameters:
585: + a - pointer to first string
586: - b - pointer to second string
588: Output Parameter:
589: . flg - if the two strings are the same
591: Notes:
592: Null arguments are ok
594: Not for use in Fortran
596: Level: intermediate
598: .seealso: PetscStrcmp(), PetscStrncmp(), PetscStrgrt()
600: @*/
601: PetscErrorCode PetscStrcasecmp(const char a[],const char b[],PetscBool *t)
602: {
603: int c;
606: if (!a && !b) c = 0;
607: else if (!a || !b) c = 1;
608: #if defined(PETSC_HAVE_STRCASECMP)
609: else c = strcasecmp(a,b);
610: #elif defined(PETSC_HAVE_STRICMP)
611: else c = stricmp(a,b);
612: #else
613: else {
614: char *aa,*bb;
616: PetscStrallocpy(a,&aa);
617: PetscStrallocpy(b,&bb);
618: PetscStrtolower(aa);
619: PetscStrtolower(bb);
620: PetscStrcmp(aa,bb,t);
621: PetscFree(aa);
622: PetscFree(bb);
623: return(0);
624: }
625: #endif
626: if (!c) *t = PETSC_TRUE;
627: else *t = PETSC_FALSE;
628: return(0);
629: }
635: /*@C
636: PetscStrncmp - Compares two strings, up to a certain length
638: Not Collective
640: Input Parameters:
641: + a - pointer to first string
642: . b - pointer to second string
643: - n - length to compare up to
645: Output Parameter:
646: . t - if the two strings are equal
648: Level: intermediate
650: Notes: Not for use in Fortran
652: .seealso: PetscStrgrt(), PetscStrcmp(), PetscStrcasecmp()
654: @*/
655: PetscErrorCode PetscStrncmp(const char a[],const char b[],size_t n,PetscBool *t)
656: {
657: int c;
660: c = strncmp(a,b,n);
661: if (!c) *t = PETSC_TRUE;
662: else *t = PETSC_FALSE;
663: return(0);
664: }
668: /*@C
669: PetscStrchr - Locates first occurance of a character in a string
671: Not Collective
673: Input Parameters:
674: + a - pointer to string
675: - b - character
677: Output Parameter:
678: . c - location of occurance, NULL if not found
680: Level: intermediate
682: Notes: Not for use in Fortran
684: @*/
685: PetscErrorCode PetscStrchr(const char a[],char b,char *c[])
686: {
688: *c = (char*)strchr(a,b);
689: return(0);
690: }
694: /*@C
695: PetscStrrchr - Locates one location past the last occurance of a character in a string,
696: if the character is not found then returns entire string
698: Not Collective
700: Input Parameters:
701: + a - pointer to string
702: - b - character
704: Output Parameter:
705: . tmp - location of occurance, a if not found
707: Level: intermediate
709: Notes: Not for use in Fortran
711: @*/
712: PetscErrorCode PetscStrrchr(const char a[],char b,char *tmp[])
713: {
715: *tmp = (char*)strrchr(a,b);
716: if (!*tmp) *tmp = (char*)a;
717: else *tmp = *tmp + 1;
718: return(0);
719: }
723: /*@C
724: PetscStrtolower - Converts string to lower case
726: Not Collective
728: Input Parameters:
729: . a - pointer to string
731: Level: intermediate
733: Notes: Not for use in Fortran
735: @*/
736: PetscErrorCode PetscStrtolower(char a[])
737: {
739: while (*a) {
740: if (*a >= 'A' && *a <= 'Z') *a += 'a' - 'A';
741: a++;
742: }
743: return(0);
744: }
748: /*@C
749: PetscStrtolower - Converts string to upper case
751: Not Collective
753: Input Parameters:
754: . a - pointer to string
756: Level: intermediate
758: Notes: Not for use in Fortran
760: @*/
761: PetscErrorCode PetscStrtoupper(char a[])
762: {
764: while (*a) {
765: if (*a >= 'a' && *a <= 'z') *a += 'A' - 'a';
766: a++;
767: }
768: return(0);
769: }
773: /*@C
774: PetscStrendswith - Determines if a string ends with a certain string
776: Not Collective
778: Input Parameters:
779: + a - pointer to string
780: - b - string to endwith
782: Output Parameter:
783: . flg - PETSC_TRUE or PETSC_FALSE
785: Notes: Not for use in Fortran
787: Level: intermediate
789: @*/
790: PetscErrorCode PetscStrendswith(const char a[],const char b[],PetscBool *flg)
791: {
792: char *test;
794: size_t na,nb;
797: *flg = PETSC_FALSE;
798: PetscStrrstr(a,b,&test);
799: if (test) {
800: PetscStrlen(a,&na);
801: PetscStrlen(b,&nb);
802: if (a+na-nb == test) *flg = PETSC_TRUE;
803: }
804: return(0);
805: }
809: /*@C
810: PetscStrbeginswith - Determines if a string begins with a certain string
812: Not Collective
814: Input Parameters:
815: + a - pointer to string
816: - b - string to beginwith
818: Output Parameter:
819: . flg - PETSC_TRUE or PETSC_FALSE
821: Notes: Not for use in Fortran
823: Level: intermediate
825: @*/
826: PetscErrorCode PetscStrbeginswith(const char a[],const char b[],PetscBool *flg)
827: {
828: char *test;
832: *flg = PETSC_FALSE;
833: PetscStrrstr(a,b,&test);
834: if (test && (test == a)) *flg = PETSC_TRUE;
835: return(0);
836: }
841: /*@C
842: PetscStrendswithwhich - Determines if a string ends with one of several possible strings
844: Not Collective
846: Input Parameters:
847: + a - pointer to string
848: - bs - strings to endwith (last entry must be null)
850: Output Parameter:
851: . cnt - the index of the string it ends with or 1+the last possible index
853: Notes: Not for use in Fortran
855: Level: intermediate
857: @*/
858: PetscErrorCode PetscStrendswithwhich(const char a[],const char *const *bs,PetscInt *cnt)
859: {
860: PetscBool flg;
864: *cnt = 0;
865: while (bs[*cnt]) {
866: PetscStrendswith(a,bs[*cnt],&flg);
867: if (flg) return(0);
868: *cnt += 1;
869: }
870: return(0);
871: }
875: /*@C
876: PetscStrrstr - Locates last occurance of string in another string
878: Not Collective
880: Input Parameters:
881: + a - pointer to string
882: - b - string to find
884: Output Parameter:
885: . tmp - location of occurance
887: Notes: Not for use in Fortran
889: Level: intermediate
891: @*/
892: PetscErrorCode PetscStrrstr(const char a[],const char b[],char *tmp[])
893: {
894: const char *stmp = a, *ltmp = 0;
897: while (stmp) {
898: stmp = (char*)strstr(stmp,b);
899: if (stmp) {ltmp = stmp;stmp++;}
900: }
901: *tmp = (char*)ltmp;
902: return(0);
903: }
907: /*@C
908: PetscStrstr - Locates first occurance of string in another string
910: Not Collective
912: Input Parameters:
913: + haystack - string to search
914: - needle - string to find
916: Output Parameter:
917: . tmp - location of occurance, is a NULL if the string is not found
919: Notes: Not for use in Fortran
921: Level: intermediate
923: @*/
924: PetscErrorCode PetscStrstr(const char haystack[],const char needle[],char *tmp[])
925: {
927: *tmp = (char*)strstr(haystack,needle);
928: return(0);
929: }
931: struct _p_PetscToken {char token;char *array;char *current;};
935: /*@C
936: PetscTokenFind - Locates next "token" in a string
938: Not Collective
940: Input Parameters:
941: . a - pointer to token
943: Output Parameter:
944: . result - location of occurance, NULL if not found
946: Notes:
948: This version is different from the system version in that
949: it allows you to pass a read-only string into the function.
951: This version also treats all characters etc. inside a double quote "
952: as a single token.
954: 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
955: second will return a null terminated y
957: 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
959: Not for use in Fortran
961: Level: intermediate
964: .seealso: PetscTokenCreate(), PetscTokenDestroy()
965: @*/
966: PetscErrorCode PetscTokenFind(PetscToken a,char *result[])
967: {
968: char *ptr = a->current,token;
971: *result = a->current;
972: if (ptr && !*ptr) {*result = 0;return(0);}
973: token = a->token;
974: if (ptr && (*ptr == '"')) {token = '"';(*result)++;ptr++;}
975: while (ptr) {
976: if (*ptr == token) {
977: *ptr++ = 0;
978: while (*ptr == a->token) ptr++;
979: a->current = ptr;
980: break;
981: }
982: if (!*ptr) {
983: a->current = 0;
984: break;
985: }
986: ptr++;
987: }
988: return(0);
989: }
993: /*@C
994: PetscTokenCreate - Creates a PetscToken used to find tokens in a string
996: Not Collective
998: Input Parameters:
999: + string - the string to look in
1000: - b - the separator character
1002: Output Parameter:
1003: . t- the token object
1005: Notes:
1007: This version is different from the system version in that
1008: it allows you to pass a read-only string into the function.
1010: Not for use in Fortran
1012: Level: intermediate
1014: .seealso: PetscTokenFind(), PetscTokenDestroy()
1015: @*/
1016: PetscErrorCode PetscTokenCreate(const char a[],const char b,PetscToken *t)
1017: {
1021: PetscNew(t);
1022: PetscStrallocpy(a,&(*t)->array);
1024: (*t)->current = (*t)->array;
1025: (*t)->token = b;
1026: return(0);
1027: }
1031: /*@C
1032: PetscTokenDestroy - Destroys a PetscToken
1034: Not Collective
1036: Input Parameters:
1037: . a - pointer to token
1039: Level: intermediate
1041: Notes: Not for use in Fortran
1043: .seealso: PetscTokenCreate(), PetscTokenFind()
1044: @*/
1045: PetscErrorCode PetscTokenDestroy(PetscToken *a)
1046: {
1050: if (!*a) return(0);
1051: PetscFree((*a)->array);
1052: PetscFree(*a);
1053: return(0);
1054: }
1059: /*@C
1060: PetscGetPetscDir - Gets the directory PETSc is installed in
1062: Not Collective
1064: Output Parameter:
1065: . dir - the directory
1067: Level: developer
1069: Notes: Not for use in Fortran
1071: @*/
1072: PetscErrorCode PetscGetPetscDir(const char *dir[])
1073: {
1075: *dir = PETSC_DIR;
1076: return(0);
1077: }
1081: /*@C
1082: PetscStrreplace - Replaces substrings in string with other substrings
1084: Not Collective
1086: Input Parameters:
1087: + comm - MPI_Comm of processors that are processing the string
1088: . aa - the string to look in
1089: . b - the resulting copy of a with replaced strings (b can be the same as a)
1090: - len - the length of b
1092: Notes:
1093: Replaces ${PETSC_ARCH},${PETSC_DIR},${PETSC_LIB_DIR},${DISPLAY},
1094: ${HOMEDIRECTORY},${WORKINGDIRECTORY},${USERNAME}, ${HOSTNAME} with appropriate values
1095: as well as any environmental variables.
1097: PETSC_LIB_DIR uses the environmental variable if it exists. PETSC_ARCH and PETSC_DIR use what
1098: PETSc was built with and do not use environmental variables.
1100: Not for use in Fortran
1102: Level: intermediate
1104: @*/
1105: PetscErrorCode PetscStrreplace(MPI_Comm comm,const char aa[],char b[],size_t len)
1106: {
1108: int i = 0;
1109: size_t l,l1,l2,l3;
1110: char *work,*par,*epar,env[1024],*tfree,*a = (char*)aa;
1111: const char *s[] = {"${PETSC_ARCH}","${PETSC_DIR}","${PETSC_LIB_DIR}","${DISPLAY}","${HOMEDIRECTORY}","${WORKINGDIRECTORY}","${USERNAME}","${HOSTNAME}",0};
1112: const char *r[] = {0,0,0,0,0,0,0,0,0};
1113: PetscBool flag;
1116: if (!a || !b) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_NULL,"a and b strings must be nonnull");
1117: if (aa == b) {
1118: PetscStrallocpy(aa,(char**)&a);
1119: }
1120: PetscMalloc1(len,&work);
1122: /* get values for replaced variables */
1123: PetscStrallocpy(PETSC_ARCH,(char**)&r[0]);
1124: PetscStrallocpy(PETSC_DIR,(char**)&r[1]);
1125: PetscStrallocpy(PETSC_LIB_DIR,(char**)&r[2]);
1126: PetscMalloc1(256,&r[3]);
1127: PetscMalloc1(PETSC_MAX_PATH_LEN,&r[4]);
1128: PetscMalloc1(PETSC_MAX_PATH_LEN,&r[5]);
1129: PetscMalloc1(256,&r[6]);
1130: PetscMalloc1(256,&r[7]);
1131: PetscGetDisplay((char*)r[3],256);
1132: PetscGetHomeDirectory((char*)r[4],PETSC_MAX_PATH_LEN);
1133: PetscGetWorkingDirectory((char*)r[5],PETSC_MAX_PATH_LEN);
1134: PetscGetUserName((char*)r[6],256);
1135: PetscGetHostName((char*)r[7],256);
1137: /* replace that are in environment */
1138: PetscOptionsGetenv(comm,"PETSC_LIB_DIR",env,1024,&flag);
1139: if (flag) {
1140: PetscFree(r[2]);
1141: PetscStrallocpy(env,(char**)&r[2]);
1142: }
1144: /* replace the requested strings */
1145: PetscStrncpy(b,a,len);
1146: while (s[i]) {
1147: PetscStrlen(s[i],&l);
1148: PetscStrstr(b,s[i],&par);
1149: while (par) {
1150: *par = 0;
1151: par += l;
1153: PetscStrlen(b,&l1);
1154: PetscStrlen(r[i],&l2);
1155: PetscStrlen(par,&l3);
1156: if (l1 + l2 + l3 >= len) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ,"b len is not long enough to hold new values");
1157: PetscStrcpy(work,b);
1158: PetscStrcat(work,r[i]);
1159: PetscStrcat(work,par);
1160: PetscStrncpy(b,work,len);
1161: PetscStrstr(b,s[i],&par);
1162: }
1163: i++;
1164: }
1165: i = 0;
1166: while (r[i]) {
1167: tfree = (char*)r[i];
1168: PetscFree(tfree);
1169: i++;
1170: }
1172: /* look for any other ${xxx} strings to replace from environmental variables */
1173: PetscStrstr(b,"${",&par);
1174: while (par) {
1175: *par = 0;
1176: par += 2;
1177: PetscStrcpy(work,b);
1178: PetscStrstr(par,"}",&epar);
1179: *epar = 0;
1180: epar += 1;
1181: PetscOptionsGetenv(comm,par,env,256,&flag);
1182: if (!flag) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"Substitution string ${%s} not found as environmental variable",par);
1183: PetscStrcat(work,env);
1184: PetscStrcat(work,epar);
1185: PetscStrcpy(b,work);
1186: PetscStrstr(b,"${",&par);
1187: }
1188: PetscFree(work);
1189: if (aa == b) {
1190: PetscFree(a);
1191: }
1192: return(0);
1193: }
1197: /*@C
1198: PetscEListFind - searches list of strings for given string, using case insensitive matching
1200: Not Collective
1202: Input Parameters:
1203: + n - number of strings in
1204: . list - list of strings to search
1205: - str - string to look for, empty string "" accepts default (first entry in list)
1207: Output Parameters:
1208: + value - index of matching string (if found)
1209: - found - boolean indicating whether string was found (can be NULL)
1211: Notes:
1212: Not for use in Fortran
1214: Level: advanced
1215: @*/
1216: PetscErrorCode PetscEListFind(PetscInt n,const char *const *list,const char *str,PetscInt *value,PetscBool *found)
1217: {
1219: PetscBool matched;
1220: PetscInt i;
1223: if (found) *found = PETSC_FALSE;
1224: for (i=0; i<n; i++) {
1225: PetscStrcasecmp(str,list[i],&matched);
1226: if (matched || !str[0]) {
1227: if (found) *found = PETSC_TRUE;
1228: *value = i;
1229: break;
1230: }
1231: }
1232: return(0);
1233: }
1237: /*@C
1238: PetscEListFind - searches enum list of strings for given string, using case insensitive matching
1240: Not Collective
1242: Input Parameters:
1243: + enumlist - list of strings to search, followed by enum name, then enum prefix, then NUL
1244: - str - string to look for
1246: Output Parameters:
1247: + value - index of matching string (if found)
1248: - found - boolean indicating whether string was found (can be NULL)
1250: Notes:
1251: Not for use in Fortran
1253: Level: advanced
1254: @*/
1255: PetscErrorCode PetscEnumFind(const char *const *enumlist,const char *str,PetscEnum *value,PetscBool *found)
1256: {
1258: PetscInt n = 0,evalue;
1259: PetscBool efound;
1262: 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");
1263: if (n < 3) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"List argument must have at least two entries: typename and type prefix");
1264: n -= 3; /* drop enum name, prefix, and null termination */
1265: PetscEListFind(n,enumlist,str,&evalue,&efound);
1266: if (efound) *value = (PetscEnum)evalue;
1267: if (found) *found = efound;
1268: return(0);
1269: }