Actual source code: str.c
petsc-3.12.5 2020-03-29
1: /*
2: We define the string operations here. The reason we just do not use
3: the standard string routines in the PETSc code is that on some machines
4: they are broken or have the wrong prototypes.
6: */
7: #include <petscsys.h>
8: #if defined(PETSC_HAVE_STRINGS_H)
9: # include <strings.h> /* strcasecmp */
10: #endif
12: /*@C
13: PetscStrToArray - Separates a string by a character (for example ' ' or '\n') and creates an array of strings
15: Not Collective
17: Input Parameters:
18: + s - pointer to string
19: - sp - separator character
21: Output Parameter:
22: + argc - the number of entries in the array
23: - args - an array of the entries with a null at the end
25: Level: intermediate
27: Notes:
28: this may be called before PetscInitialize() or after PetscFinalize()
30: Not for use in Fortran
32: Developer Notes:
33: Using raw malloc() and does not call error handlers since this may be used before PETSc is initialized. Used
34: to generate argc, args arguments passed to MPI_Init()
36: .seealso: PetscStrToArrayDestroy(), PetscToken, PetscTokenCreate()
38: @*/
39: PetscErrorCode PetscStrToArray(const char s[],char sp,int *argc,char ***args)
40: {
41: int i,j,n,*lens,cnt = 0;
42: PetscBool flg = PETSC_FALSE;
44: if (!s) n = 0;
45: else n = strlen(s);
46: *argc = 0;
47: *args = NULL;
48: for (; n>0; n--) { /* remove separator chars at the end - and will empty the string if all chars are separator chars */
49: if (s[n-1] != sp) break;
50: }
51: if (!n) {
52: return(0);
53: }
54: for (i=0; i<n; i++) {
55: if (s[i] != sp) break;
56: }
57: for (;i<n+1; i++) {
58: if ((s[i] == sp || s[i] == 0) && !flg) {flg = PETSC_TRUE; (*argc)++;}
59: else if (s[i] != sp) {flg = PETSC_FALSE;}
60: }
61: (*args) = (char**) malloc(((*argc)+1)*sizeof(char*)); if (!*args) return PETSC_ERR_MEM;
62: lens = (int*) malloc((*argc)*sizeof(int)); if (!lens) return PETSC_ERR_MEM;
63: for (i=0; i<*argc; i++) lens[i] = 0;
65: *argc = 0;
66: for (i=0; i<n; i++) {
67: if (s[i] != sp) break;
68: }
69: for (;i<n+1; i++) {
70: if ((s[i] == sp || s[i] == 0) && !flg) {flg = PETSC_TRUE; (*argc)++;}
71: else if (s[i] != sp) {lens[*argc]++;flg = PETSC_FALSE;}
72: }
74: for (i=0; i<*argc; i++) {
75: (*args)[i] = (char*) malloc((lens[i]+1)*sizeof(char));
76: if (!(*args)[i]) {
77: free(lens);
78: for (j=0; j<i; j++) free((*args)[j]);
79: free(*args);
80: return PETSC_ERR_MEM;
81: }
82: }
83: free(lens);
84: (*args)[*argc] = 0;
86: *argc = 0;
87: for (i=0; i<n; i++) {
88: if (s[i] != sp) break;
89: }
90: for (;i<n+1; i++) {
91: if ((s[i] == sp || s[i] == 0) && !flg) {flg = PETSC_TRUE; (*args)[*argc][cnt++] = 0; (*argc)++; cnt = 0;}
92: else if (s[i] != sp && s[i] != 0) {(*args)[*argc][cnt++] = s[i]; flg = PETSC_FALSE;}
93: }
94: return 0;
95: }
97: /*@C
98: PetscStrToArrayDestroy - Frees array created with PetscStrToArray().
100: Not Collective
102: Output Parameters:
103: + argc - the number of arguments
104: - args - the array of arguments
106: Level: intermediate
108: Notes:
109: This may be called before PetscInitialize() or after PetscFinalize()
111: Not for use in Fortran
113: .seealso: PetscStrToArray()
115: @*/
116: PetscErrorCode PetscStrToArrayDestroy(int argc,char **args)
117: {
118: PetscInt i;
120: for (i=0; i<argc; i++) free(args[i]);
121: if (args) free(args);
122: return 0;
123: }
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: @*/
146: PetscErrorCode PetscStrlen(const char s[],size_t *len)
147: {
149: if (!s) *len = 0;
150: else *len = strlen(s);
151: return(0);
152: }
154: /*@C
155: PetscStrallocpy - Allocates space to hold a copy of a string then copies the string
157: Not Collective
159: Input Parameters:
160: . s - pointer to string
162: Output Parameter:
163: . t - the copied string
165: Level: intermediate
167: Note:
168: Null string returns a new null string
170: Not for use in Fortran
172: @*/
173: PetscErrorCode PetscStrallocpy(const char s[],char *t[])
174: {
176: size_t len;
177: char *tmp = 0;
180: if (s) {
181: PetscStrlen(s,&len);
182: PetscMalloc1(1+len,&tmp);
183: PetscStrcpy(tmp,s);
184: }
185: *t = tmp;
186: return(0);
187: }
189: /*@C
190: PetscStrArrayallocpy - Allocates space to hold a copy of an array of strings then copies the strings
192: Not Collective
194: Input Parameters:
195: . s - pointer to array of strings (final string is a null)
197: Output Parameter:
198: . t - the copied array string
200: Level: intermediate
202: Note:
203: Not for use in Fortran
205: .seealso: PetscStrallocpy() PetscStrArrayDestroy()
207: @*/
208: PetscErrorCode PetscStrArrayallocpy(const char *const *list,char ***t)
209: {
211: PetscInt i,n = 0;
214: while (list[n++]) ;
215: PetscMalloc1(n+1,t);
216: for (i=0; i<n; i++) {
217: PetscStrallocpy(list[i],(*t)+i);
218: }
219: (*t)[n] = NULL;
220: return(0);
221: }
223: /*@C
224: PetscStrArrayDestroy - Frees array of strings created with PetscStrArrayallocpy().
226: Not Collective
228: Output Parameters:
229: . list - array of strings
231: Level: intermediate
233: Notes:
234: Not for use in Fortran
236: .seealso: PetscStrArrayallocpy()
238: @*/
239: PetscErrorCode PetscStrArrayDestroy(char ***list)
240: {
241: PetscInt n = 0;
245: if (!*list) return(0);
246: while ((*list)[n]) {
247: PetscFree((*list)[n]);
248: n++;
249: }
250: PetscFree(*list);
251: return(0);
252: }
254: /*@C
255: PetscStrNArrayallocpy - Allocates space to hold a copy of an array of strings then copies the strings
257: Not Collective
259: Input Parameters:
260: + n - the number of string entries
261: - s - pointer to array of strings
263: Output Parameter:
264: . t - the copied array string
266: Level: intermediate
268: Note:
269: Not for use in Fortran
271: .seealso: PetscStrallocpy() PetscStrArrayDestroy()
273: @*/
274: PetscErrorCode PetscStrNArrayallocpy(PetscInt n,const char *const *list,char ***t)
275: {
277: PetscInt i;
280: PetscMalloc1(n,t);
281: for (i=0; i<n; i++) {
282: PetscStrallocpy(list[i],(*t)+i);
283: }
284: return(0);
285: }
287: /*@C
288: PetscStrNArrayDestroy - Frees array of strings created with PetscStrArrayallocpy().
290: Not Collective
292: Output Parameters:
293: + n - number of string entries
294: - list - array of strings
296: Level: intermediate
298: Notes:
299: Not for use in Fortran
301: .seealso: PetscStrArrayallocpy()
303: @*/
304: PetscErrorCode PetscStrNArrayDestroy(PetscInt n,char ***list)
305: {
307: PetscInt i;
310: if (!*list) return(0);
311: for (i=0; i<n; i++){
312: PetscFree((*list)[i]);
313: }
314: PetscFree(*list);
315: return(0);
316: }
318: /*@C
319: PetscStrcpy - Copies a string
321: Not Collective
323: Input Parameters:
324: . t - pointer to string
326: Output Parameter:
327: . s - the copied string
329: Level: intermediate
331: Notes:
332: Null string returns a string starting with zero
334: Not for use in Fortran
336: .seealso: PetscStrncpy(), PetscStrcat(), PetscStrlcat()
338: @*/
340: PetscErrorCode PetscStrcpy(char s[],const char t[])
341: {
343: if (t && !s) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_NULL,"Trying to copy string into null pointer");
344: if (t) strcpy(s,t);
345: else if (s) s[0] = 0;
346: return(0);
347: }
349: /*@C
350: PetscStrncpy - Copies a string up to a certain length
352: Not Collective
354: Input Parameters:
355: + t - pointer to string
356: - n - the length to copy
358: Output Parameter:
359: . s - the copied string
361: Level: intermediate
363: Note:
364: Null string returns a string starting with zero
366: If the string that is being copied is of length n or larger then the entire string is not
367: copied and the final location of s is set to NULL. This is different then the behavior of
368: strncpy() which leaves s non-terminated if there is not room for the entire string.
370: Developers Note: Should this be PetscStrlcpy() to reflect its behavior which is like strlcpy() not strncpy()
372: .seealso: PetscStrcpy(), PetscStrcat(), PetscStrlcat()
374: @*/
375: PetscErrorCode PetscStrncpy(char s[],const char t[],size_t n)
376: {
378: if (t && !s) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_NULL,"Trying to copy string into null pointer");
379: if (s && !n) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_NULL,"Requires an output string of length at least 1 to hold the termination character");
380: if (t) {
381: if (n > 1) {
382: strncpy(s,t,n-1);
383: s[n-1] = '\0';
384: } else {
385: s[0] = '\0';
386: }
387: } else if (s) s[0] = 0;
388: return(0);
389: }
391: /*@C
392: PetscStrcat - Concatenates a string onto a given string
394: Not Collective
396: Input Parameters:
397: + s - string to be added to
398: - t - pointer to string to be added to end
400: Level: intermediate
402: Notes:
403: Not for use in Fortran
405: .seealso: PetscStrcpy(), PetscStrncpy(), PetscStrlcat()
407: @*/
408: PetscErrorCode PetscStrcat(char s[],const char t[])
409: {
411: if (!t) return(0);
412: strcat(s,t);
413: return(0);
414: }
416: /*@C
417: PetscStrlcat - Concatenates a string onto a given string, up to a given length
419: Not Collective
421: Input Parameters:
422: + s - pointer to string to be added to at end
423: . t - string to be added to
424: - n - length of the original allocated string
426: Level: intermediate
428: Notes:
429: Not for use in Fortran
431: Unlike the system call strncat(), the length passed in is the length of the
432: original allocated space, not the length of the left-over space. This is
433: similar to the BSD system call strlcat().
435: .seealso: PetscStrcpy(), PetscStrncpy(), PetscStrcat()
437: @*/
438: PetscErrorCode PetscStrlcat(char s[],const char t[],size_t n)
439: {
440: size_t len;
444: if (t && !n) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ,"String buffer length must be positive");
445: if (!t) return(0);
446: PetscStrlen(t,&len);
447: strncat(s,t,n - len);
448: s[n-1] = 0;
449: return(0);
450: }
452: void PetscStrcmpNoError(const char a[],const char b[],PetscBool *flg)
453: {
454: int c;
456: if (!a && !b) *flg = PETSC_TRUE;
457: else if (!a || !b) *flg = PETSC_FALSE;
458: else {
459: c = strcmp(a,b);
460: if (c) *flg = PETSC_FALSE;
461: else *flg = PETSC_TRUE;
462: }
463: }
465: /*@C
466: PetscStrcmp - Compares two strings,
468: Not Collective
470: Input Parameters:
471: + a - pointer to string first string
472: - b - pointer to second string
474: Output Parameter:
475: . flg - PETSC_TRUE if the two strings are equal
477: Level: intermediate
479: Notes:
480: Not for use in Fortran
482: .seealso: PetscStrgrt(), PetscStrncmp(), PetscStrcasecmp()
484: @*/
485: PetscErrorCode PetscStrcmp(const char a[],const char b[],PetscBool *flg)
486: {
487: 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: return(0);
498: }
500: /*@C
501: PetscStrgrt - If first string is greater than the second
503: Not Collective
505: Input Parameters:
506: + a - pointer to first string
507: - b - pointer to second string
509: Output Parameter:
510: . flg - if the first string is greater
512: Notes:
513: Null arguments are ok, a null string is considered smaller than
514: all others
516: Not for use in Fortran
518: Level: intermediate
520: .seealso: PetscStrcmp(), PetscStrncmp(), PetscStrcasecmp()
522: @*/
523: PetscErrorCode PetscStrgrt(const char a[],const char b[],PetscBool *t)
524: {
525: int c;
528: if (!a && !b) *t = PETSC_FALSE;
529: else if (a && !b) *t = PETSC_TRUE;
530: else if (!a && b) *t = PETSC_FALSE;
531: else {
532: c = strcmp(a,b);
533: if (c > 0) *t = PETSC_TRUE;
534: else *t = PETSC_FALSE;
535: }
536: return(0);
537: }
539: /*@C
540: PetscStrcasecmp - Returns true if the two strings are the same
541: except possibly for case.
543: Not Collective
545: Input Parameters:
546: + a - pointer to first string
547: - b - pointer to second string
549: Output Parameter:
550: . flg - if the two strings are the same
552: Notes:
553: Null arguments are ok
555: Not for use in Fortran
557: Level: intermediate
559: .seealso: PetscStrcmp(), PetscStrncmp(), PetscStrgrt()
561: @*/
562: PetscErrorCode PetscStrcasecmp(const char a[],const char b[],PetscBool *t)
563: {
564: int c;
567: if (!a && !b) c = 0;
568: else if (!a || !b) c = 1;
569: #if defined(PETSC_HAVE_STRCASECMP)
570: else c = strcasecmp(a,b);
571: #elif defined(PETSC_HAVE_STRICMP)
572: else c = stricmp(a,b);
573: #else
574: else {
575: char *aa,*bb;
577: PetscStrallocpy(a,&aa);
578: PetscStrallocpy(b,&bb);
579: PetscStrtolower(aa);
580: PetscStrtolower(bb);
581: PetscStrcmp(aa,bb,t);
582: PetscFree(aa);
583: PetscFree(bb);
584: return(0);
585: }
586: #endif
587: if (!c) *t = PETSC_TRUE;
588: else *t = PETSC_FALSE;
589: return(0);
590: }
594: /*@C
595: PetscStrncmp - Compares two strings, up to a certain length
597: Not Collective
599: Input Parameters:
600: + a - pointer to first string
601: . b - pointer to second string
602: - n - length to compare up to
604: Output Parameter:
605: . t - if the two strings are equal
607: Level: intermediate
609: Notes:
610: Not for use in Fortran
612: .seealso: PetscStrgrt(), PetscStrcmp(), PetscStrcasecmp()
614: @*/
615: PetscErrorCode PetscStrncmp(const char a[],const char b[],size_t n,PetscBool *t)
616: {
617: int c;
620: c = strncmp(a,b,n);
621: if (!c) *t = PETSC_TRUE;
622: else *t = PETSC_FALSE;
623: return(0);
624: }
626: /*@C
627: PetscStrchr - Locates first occurance of a character in a string
629: Not Collective
631: Input Parameters:
632: + a - pointer to string
633: - b - character
635: Output Parameter:
636: . c - location of occurance, NULL if not found
638: Level: intermediate
640: Notes:
641: Not for use in Fortran
643: @*/
644: PetscErrorCode PetscStrchr(const char a[],char b,char *c[])
645: {
647: *c = (char*)strchr(a,b);
648: return(0);
649: }
651: /*@C
652: PetscStrrchr - Locates one location past the last occurance of a character in a string,
653: if the character is not found then returns entire string
655: Not Collective
657: Input Parameters:
658: + a - pointer to string
659: - b - character
661: Output Parameter:
662: . tmp - location of occurance, a if not found
664: Level: intermediate
666: Notes:
667: Not for use in Fortran
669: @*/
670: PetscErrorCode PetscStrrchr(const char a[],char b,char *tmp[])
671: {
673: *tmp = (char*)strrchr(a,b);
674: if (!*tmp) *tmp = (char*)a;
675: else *tmp = *tmp + 1;
676: return(0);
677: }
679: /*@C
680: PetscStrtolower - Converts string to lower case
682: Not Collective
684: Input Parameters:
685: . a - pointer to string
687: Level: intermediate
689: Notes:
690: Not for use in Fortran
692: @*/
693: PetscErrorCode PetscStrtolower(char a[])
694: {
696: while (*a) {
697: if (*a >= 'A' && *a <= 'Z') *a += 'a' - 'A';
698: a++;
699: }
700: return(0);
701: }
703: /*@C
704: PetscStrtoupper - Converts string to upper case
706: Not Collective
708: Input Parameters:
709: . a - pointer to string
711: Level: intermediate
713: Notes:
714: Not for use in Fortran
716: @*/
717: PetscErrorCode PetscStrtoupper(char a[])
718: {
720: while (*a) {
721: if (*a >= 'a' && *a <= 'z') *a += 'A' - 'a';
722: a++;
723: }
724: return(0);
725: }
727: /*@C
728: PetscStrendswith - Determines if a string ends with a certain string
730: Not Collective
732: Input Parameters:
733: + a - pointer to string
734: - b - string to endwith
736: Output Parameter:
737: . flg - PETSC_TRUE or PETSC_FALSE
739: Notes:
740: Not for use in Fortran
742: Level: intermediate
744: @*/
745: PetscErrorCode PetscStrendswith(const char a[],const char b[],PetscBool *flg)
746: {
747: char *test;
749: size_t na,nb;
752: *flg = PETSC_FALSE;
753: PetscStrrstr(a,b,&test);
754: if (test) {
755: PetscStrlen(a,&na);
756: PetscStrlen(b,&nb);
757: if (a+na-nb == test) *flg = PETSC_TRUE;
758: }
759: return(0);
760: }
762: /*@C
763: PetscStrbeginswith - Determines if a string begins with a certain string
765: Not Collective
767: Input Parameters:
768: + a - pointer to string
769: - b - string to begin with
771: Output Parameter:
772: . flg - PETSC_TRUE or PETSC_FALSE
774: Notes:
775: Not for use in Fortran
777: Level: intermediate
779: .seealso: PetscStrendswithwhich(), PetscStrendswith(), PetscStrtoupper, PetscStrtolower(), PetscStrrchr(), PetscStrchr(),
780: PetscStrncmp(), PetscStrlen(), PetscStrncmp(), PetscStrcmp()
782: @*/
783: PetscErrorCode PetscStrbeginswith(const char a[],const char b[],PetscBool *flg)
784: {
785: char *test;
789: *flg = PETSC_FALSE;
790: PetscStrrstr(a,b,&test);
791: if (test && (test == a)) *flg = PETSC_TRUE;
792: return(0);
793: }
796: /*@C
797: PetscStrendswithwhich - Determines if a string ends with one of several possible strings
799: Not Collective
801: Input Parameters:
802: + a - pointer to string
803: - bs - strings to endwith (last entry must be null)
805: Output Parameter:
806: . cnt - the index of the string it ends with or 1+the last possible index
808: Notes:
809: Not for use in Fortran
811: Level: intermediate
813: @*/
814: PetscErrorCode PetscStrendswithwhich(const char a[],const char *const *bs,PetscInt *cnt)
815: {
816: PetscBool flg;
820: *cnt = 0;
821: while (bs[*cnt]) {
822: PetscStrendswith(a,bs[*cnt],&flg);
823: if (flg) return(0);
824: *cnt += 1;
825: }
826: return(0);
827: }
829: /*@C
830: PetscStrrstr - Locates last occurance of string in another string
832: Not Collective
834: Input Parameters:
835: + a - pointer to string
836: - b - string to find
838: Output Parameter:
839: . tmp - location of occurance
841: Notes:
842: Not for use in Fortran
844: Level: intermediate
846: @*/
847: PetscErrorCode PetscStrrstr(const char a[],const char b[],char *tmp[])
848: {
849: const char *stmp = a, *ltmp = 0;
852: while (stmp) {
853: stmp = (char*)strstr(stmp,b);
854: if (stmp) {ltmp = stmp;stmp++;}
855: }
856: *tmp = (char*)ltmp;
857: return(0);
858: }
860: /*@C
861: PetscStrstr - Locates first occurance of string in another string
863: Not Collective
865: Input Parameters:
866: + haystack - string to search
867: - needle - string to find
869: Output Parameter:
870: . tmp - location of occurance, is a NULL if the string is not found
872: Notes:
873: Not for use in Fortran
875: Level: intermediate
877: @*/
878: PetscErrorCode PetscStrstr(const char haystack[],const char needle[],char *tmp[])
879: {
881: *tmp = (char*)strstr(haystack,needle);
882: return(0);
883: }
885: struct _p_PetscToken {char token;char *array;char *current;};
887: /*@C
888: PetscTokenFind - Locates next "token" in a string
890: Not Collective
892: Input Parameters:
893: . a - pointer to token
895: Output Parameter:
896: . result - location of occurance, NULL if not found
898: Notes:
900: This version is different from the system version in that
901: it allows you to pass a read-only string into the function.
903: This version also treats all characters etc. inside a double quote "
904: as a single token.
906: 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
907: second will return a null terminated y
909: 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
911: Not for use in Fortran
913: Level: intermediate
916: .seealso: PetscTokenCreate(), PetscTokenDestroy()
917: @*/
918: PetscErrorCode PetscTokenFind(PetscToken a,char *result[])
919: {
920: char *ptr = a->current,token;
923: *result = a->current;
924: if (ptr && !*ptr) {*result = 0;return(0);}
925: token = a->token;
926: if (ptr && (*ptr == '"')) {token = '"';(*result)++;ptr++;}
927: while (ptr) {
928: if (*ptr == token) {
929: *ptr++ = 0;
930: while (*ptr == a->token) ptr++;
931: a->current = ptr;
932: break;
933: }
934: if (!*ptr) {
935: a->current = 0;
936: break;
937: }
938: ptr++;
939: }
940: return(0);
941: }
943: /*@C
944: PetscTokenCreate - Creates a PetscToken used to find tokens in a string
946: Not Collective
948: Input Parameters:
949: + string - the string to look in
950: - b - the separator character
952: Output Parameter:
953: . t- the token object
955: Notes:
957: This version is different from the system version in that
958: it allows you to pass a read-only string into the function.
960: Not for use in Fortran
962: Level: intermediate
964: .seealso: PetscTokenFind(), PetscTokenDestroy()
965: @*/
966: PetscErrorCode PetscTokenCreate(const char a[],const char b,PetscToken *t)
967: {
971: PetscNew(t);
972: PetscStrallocpy(a,&(*t)->array);
974: (*t)->current = (*t)->array;
975: (*t)->token = b;
976: return(0);
977: }
979: /*@C
980: PetscTokenDestroy - Destroys a PetscToken
982: Not Collective
984: Input Parameters:
985: . a - pointer to token
987: Level: intermediate
989: Notes:
990: Not for use in Fortran
992: .seealso: PetscTokenCreate(), PetscTokenFind()
993: @*/
994: PetscErrorCode PetscTokenDestroy(PetscToken *a)
995: {
999: if (!*a) return(0);
1000: PetscFree((*a)->array);
1001: PetscFree(*a);
1002: return(0);
1003: }
1005: /*@C
1006: PetscStrInList - search string in character-delimited list
1008: Not Collective
1010: Input Parameters:
1011: + str - the string to look for
1012: . list - the list to search in
1013: - sep - the separator character
1015: Output Parameter:
1016: . found - whether str is in list
1018: Level: intermediate
1020: Notes:
1021: Not for use in Fortran
1023: .seealso: PetscTokenCreate(), PetscTokenFind(), PetscStrcmp()
1024: @*/
1025: PetscErrorCode PetscStrInList(const char str[],const char list[],char sep,PetscBool *found)
1026: {
1027: PetscToken token;
1028: char *item;
1032: *found = PETSC_FALSE;
1033: PetscTokenCreate(list,sep,&token);
1034: PetscTokenFind(token,&item);
1035: while (item) {
1036: PetscStrcmp(str,item,found);
1037: if (*found) break;
1038: PetscTokenFind(token,&item);
1039: }
1040: PetscTokenDestroy(&token);
1041: return(0);
1042: }
1044: /*@C
1045: PetscGetPetscDir - Gets the directory PETSc is installed in
1047: Not Collective
1049: Output Parameter:
1050: . dir - the directory
1052: Level: developer
1054: Notes:
1055: Not for use in Fortran
1057: @*/
1058: PetscErrorCode PetscGetPetscDir(const char *dir[])
1059: {
1061: *dir = PETSC_DIR;
1062: return(0);
1063: }
1065: /*@C
1066: PetscStrreplace - Replaces substrings in string with other substrings
1068: Not Collective
1070: Input Parameters:
1071: + comm - MPI_Comm of processors that are processing the string
1072: . aa - the string to look in
1073: . b - the resulting copy of a with replaced strings (b can be the same as a)
1074: - len - the length of b
1076: Notes:
1077: Replaces ${PETSC_ARCH},${PETSC_DIR},${PETSC_LIB_DIR},${DISPLAY},
1078: ${HOMEDIRECTORY},${WORKINGDIRECTORY},${USERNAME}, ${HOSTNAME} with appropriate values
1079: as well as any environmental variables.
1081: PETSC_LIB_DIR uses the environmental variable if it exists. PETSC_ARCH and PETSC_DIR use what
1082: PETSc was built with and do not use environmental variables.
1084: Not for use in Fortran
1086: Level: intermediate
1088: @*/
1089: PetscErrorCode PetscStrreplace(MPI_Comm comm,const char aa[],char b[],size_t len)
1090: {
1092: int i = 0;
1093: size_t l,l1,l2,l3;
1094: char *work,*par,*epar,env[1024],*tfree,*a = (char*)aa;
1095: const char *s[] = {"${PETSC_ARCH}","${PETSC_DIR}","${PETSC_LIB_DIR}","${DISPLAY}","${HOMEDIRECTORY}","${WORKINGDIRECTORY}","${USERNAME}","${HOSTNAME}",0};
1096: char *r[] = {0,0,0,0,0,0,0,0,0};
1097: PetscBool flag;
1100: if (!a || !b) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_NULL,"a and b strings must be nonnull");
1101: if (aa == b) {
1102: PetscStrallocpy(aa,(char**)&a);
1103: }
1104: PetscMalloc1(len,&work);
1106: /* get values for replaced variables */
1107: PetscStrallocpy(PETSC_ARCH,&r[0]);
1108: PetscStrallocpy(PETSC_DIR,&r[1]);
1109: PetscStrallocpy(PETSC_LIB_DIR,&r[2]);
1110: PetscMalloc1(256,&r[3]);
1111: PetscMalloc1(PETSC_MAX_PATH_LEN,&r[4]);
1112: PetscMalloc1(PETSC_MAX_PATH_LEN,&r[5]);
1113: PetscMalloc1(256,&r[6]);
1114: PetscMalloc1(256,&r[7]);
1115: PetscGetDisplay(r[3],256);
1116: PetscGetHomeDirectory(r[4],PETSC_MAX_PATH_LEN);
1117: PetscGetWorkingDirectory(r[5],PETSC_MAX_PATH_LEN);
1118: PetscGetUserName(r[6],256);
1119: PetscGetHostName(r[7],256);
1121: /* replace that are in environment */
1122: PetscOptionsGetenv(comm,"PETSC_LIB_DIR",env,1024,&flag);
1123: if (flag) {
1124: PetscFree(r[2]);
1125: PetscStrallocpy(env,&r[2]);
1126: }
1128: /* replace the requested strings */
1129: PetscStrncpy(b,a,len);
1130: while (s[i]) {
1131: PetscStrlen(s[i],&l);
1132: PetscStrstr(b,s[i],&par);
1133: while (par) {
1134: *par = 0;
1135: par += l;
1137: PetscStrlen(b,&l1);
1138: PetscStrlen(r[i],&l2);
1139: PetscStrlen(par,&l3);
1140: if (l1 + l2 + l3 >= len) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ,"b len is not long enough to hold new values");
1141: PetscStrcpy(work,b);
1142: PetscStrcat(work,r[i]);
1143: PetscStrcat(work,par);
1144: PetscStrncpy(b,work,len);
1145: PetscStrstr(b,s[i],&par);
1146: }
1147: i++;
1148: }
1149: i = 0;
1150: while (r[i]) {
1151: tfree = (char*)r[i];
1152: PetscFree(tfree);
1153: i++;
1154: }
1156: /* look for any other ${xxx} strings to replace from environmental variables */
1157: PetscStrstr(b,"${",&par);
1158: while (par) {
1159: *par = 0;
1160: par += 2;
1161: PetscStrcpy(work,b);
1162: PetscStrstr(par,"}",&epar);
1163: *epar = 0;
1164: epar += 1;
1165: PetscOptionsGetenv(comm,par,env,256,&flag);
1166: if (!flag) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"Substitution string ${%s} not found as environmental variable",par);
1167: PetscStrcat(work,env);
1168: PetscStrcat(work,epar);
1169: PetscStrcpy(b,work);
1170: PetscStrstr(b,"${",&par);
1171: }
1172: PetscFree(work);
1173: if (aa == b) {
1174: PetscFree(a);
1175: }
1176: return(0);
1177: }
1179: /*@C
1180: PetscEListFind - searches list of strings for given string, using case insensitive matching
1182: Not Collective
1184: Input Parameters:
1185: + n - number of strings in
1186: . list - list of strings to search
1187: - str - string to look for, empty string "" accepts default (first entry in list)
1189: Output Parameters:
1190: + value - index of matching string (if found)
1191: - found - boolean indicating whether string was found (can be NULL)
1193: Notes:
1194: Not for use in Fortran
1196: Level: advanced
1197: @*/
1198: PetscErrorCode PetscEListFind(PetscInt n,const char *const *list,const char *str,PetscInt *value,PetscBool *found)
1199: {
1201: PetscBool matched;
1202: PetscInt i;
1205: if (found) *found = PETSC_FALSE;
1206: for (i=0; i<n; i++) {
1207: PetscStrcasecmp(str,list[i],&matched);
1208: if (matched || !str[0]) {
1209: if (found) *found = PETSC_TRUE;
1210: *value = i;
1211: break;
1212: }
1213: }
1214: return(0);
1215: }
1217: /*@C
1218: PetscEnumFind - searches enum list of strings for given string, using case insensitive matching
1220: Not Collective
1222: Input Parameters:
1223: + enumlist - list of strings to search, followed by enum name, then enum prefix, then NUL
1224: - str - string to look for
1226: Output Parameters:
1227: + value - index of matching string (if found)
1228: - found - boolean indicating whether string was found (can be NULL)
1230: Notes:
1231: Not for use in Fortran
1233: Level: advanced
1234: @*/
1235: PetscErrorCode PetscEnumFind(const char *const *enumlist,const char *str,PetscEnum *value,PetscBool *found)
1236: {
1238: PetscInt n = 0,evalue;
1239: PetscBool efound;
1242: 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");
1243: if (n < 3) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"List argument must have at least two entries: typename and type prefix");
1244: n -= 3; /* drop enum name, prefix, and null termination */
1245: PetscEListFind(n,enumlist,str,&evalue,&efound);
1246: if (efound) *value = (PetscEnum)evalue;
1247: if (found) *found = efound;
1248: return(0);
1249: }