Actual source code: str.c
petsc-3.12.4 2020-02-04
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>
9: #if defined(PETSC_HAVE_STRINGS_H)
10: # include <strings.h> /* strcasecmp */
11: #endif
13: /*@C
14: PetscStrToArray - Separates a string by a charactor (for example ' ' or '\n') and creates an array of strings
16: Not Collective
18: Input Parameters:
19: + s - pointer to string
20: - sp - separator charactor
22: Output Parameter:
23: + argc - the number of entries in the array
24: - args - an array of the entries with a null at the end
26: Level: intermediate
28: Notes:
29: this may be called before PetscInitialize() or after PetscFinalize()
31: Not for use in Fortran
33: Developer Notes:
34: Using raw malloc() and does not call error handlers since this may be used before PETSc is initialized. Used
35: to generate argc, args arguments passed to MPI_Init()
37: .seealso: PetscStrToArrayDestroy(), PetscToken, PetscTokenCreate()
39: @*/
40: PetscErrorCode PetscStrToArray(const char s[],char sp,int *argc,char ***args)
41: {
42: int i,j,n,*lens,cnt = 0;
43: PetscBool flg = PETSC_FALSE;
45: if (!s) n = 0;
46: else n = strlen(s);
47: *argc = 0;
48: *args = NULL;
49: for (; n>0; n--) { /* remove separator chars at the end - and will empty the string if all chars are separator chars */
50: if (s[n-1] != sp) break;
51: }
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: (*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));
77: if (!(*args)[i]) {
78: free(lens);
79: for (j=0; j<i; j++) free((*args)[j]);
80: free(*args);
81: return PETSC_ERR_MEM;
82: }
83: }
84: free(lens);
85: (*args)[*argc] = 0;
87: *argc = 0;
88: for (i=0; i<n; i++) {
89: if (s[i] != sp) break;
90: }
91: for (;i<n+1; i++) {
92: if ((s[i] == sp || s[i] == 0) && !flg) {flg = PETSC_TRUE; (*args)[*argc][cnt++] = 0; (*argc)++; cnt = 0;}
93: else if (s[i] != sp && s[i] != 0) {(*args)[*argc][cnt++] = s[i]; flg = PETSC_FALSE;}
94: }
95: return 0;
96: }
98: /*@C
99: PetscStrToArrayDestroy - Frees array created with PetscStrToArray().
101: Not Collective
103: Output Parameters:
104: + argc - the number of arguments
105: - args - the array of arguments
107: Level: intermediate
109: Notes:
110: This may be called before PetscInitialize() or after PetscFinalize()
112: Not for use in Fortran
114: .seealso: PetscStrToArray()
116: @*/
117: PetscErrorCode PetscStrToArrayDestroy(int argc,char **args)
118: {
119: PetscInt i;
121: for (i=0; i<argc; i++) free(args[i]);
122: if (args) free(args);
123: return 0;
124: }
126: /*@C
127: PetscStrlen - Gets length of a string
129: Not Collective
131: Input Parameters:
132: . s - pointer to string
134: Output Parameter:
135: . len - length in bytes
137: Level: intermediate
139: Note:
140: This routine is analogous to strlen().
142: Null string returns a length of zero
144: Not for use in Fortran
146: @*/
147: PetscErrorCode PetscStrlen(const char s[],size_t *len)
148: {
150: if (!s) *len = 0;
151: else *len = strlen(s);
152: return(0);
153: }
155: /*@C
156: PetscStrallocpy - Allocates space to hold a copy of a string then copies the string
158: Not Collective
160: Input Parameters:
161: . s - pointer to string
163: Output Parameter:
164: . t - the copied string
166: Level: intermediate
168: Note:
169: Null string returns a new null string
171: Not for use in Fortran
173: @*/
174: PetscErrorCode PetscStrallocpy(const char s[],char *t[])
175: {
177: size_t len;
178: char *tmp = 0;
181: if (s) {
182: PetscStrlen(s,&len);
183: PetscMalloc1(1+len,&tmp);
184: PetscStrcpy(tmp,s);
185: }
186: *t = tmp;
187: return(0);
188: }
190: /*@C
191: PetscStrArrayallocpy - Allocates space to hold a copy of an array of strings then copies the strings
193: Not Collective
195: Input Parameters:
196: . s - pointer to array of strings (final string is a null)
198: Output Parameter:
199: . t - the copied array string
201: Level: intermediate
203: Note:
204: Not for use in Fortran
206: .seealso: PetscStrallocpy() PetscStrArrayDestroy()
208: @*/
209: PetscErrorCode PetscStrArrayallocpy(const char *const *list,char ***t)
210: {
212: PetscInt i,n = 0;
215: while (list[n++]) ;
216: PetscMalloc1(n+1,t);
217: for (i=0; i<n; i++) {
218: PetscStrallocpy(list[i],(*t)+i);
219: }
220: (*t)[n] = NULL;
221: return(0);
222: }
224: /*@C
225: PetscStrArrayDestroy - Frees array of strings created with PetscStrArrayallocpy().
227: Not Collective
229: Output Parameters:
230: . list - array of strings
232: Level: intermediate
234: Notes:
235: Not for use in Fortran
237: .seealso: PetscStrArrayallocpy()
239: @*/
240: PetscErrorCode PetscStrArrayDestroy(char ***list)
241: {
242: PetscInt n = 0;
246: if (!*list) return(0);
247: while ((*list)[n]) {
248: PetscFree((*list)[n]);
249: n++;
250: }
251: PetscFree(*list);
252: return(0);
253: }
255: /*@C
256: PetscStrNArrayallocpy - Allocates space to hold a copy of an array of strings then copies the strings
258: Not Collective
260: Input Parameters:
261: + n - the number of string entries
262: - s - pointer to array of strings
264: Output Parameter:
265: . t - the copied array string
267: Level: intermediate
269: Note:
270: Not for use in Fortran
272: .seealso: PetscStrallocpy() PetscStrArrayDestroy()
274: @*/
275: PetscErrorCode PetscStrNArrayallocpy(PetscInt n,const char *const *list,char ***t)
276: {
278: PetscInt i;
281: PetscMalloc1(n,t);
282: for (i=0; i<n; i++) {
283: PetscStrallocpy(list[i],(*t)+i);
284: }
285: return(0);
286: }
288: /*@C
289: PetscStrNArrayDestroy - Frees array of strings created with PetscStrArrayallocpy().
291: Not Collective
293: Output Parameters:
294: + n - number of string entries
295: - list - array of strings
297: Level: intermediate
299: Notes:
300: Not for use in Fortran
302: .seealso: PetscStrArrayallocpy()
304: @*/
305: PetscErrorCode PetscStrNArrayDestroy(PetscInt n,char ***list)
306: {
308: PetscInt i;
311: if (!*list) return(0);
312: for (i=0; i<n; i++){
313: PetscFree((*list)[i]);
314: }
315: PetscFree(*list);
316: return(0);
317: }
319: /*@C
320: PetscStrcpy - Copies a string
322: Not Collective
324: Input Parameters:
325: . t - pointer to string
327: Output Parameter:
328: . s - the copied string
330: Level: intermediate
332: Notes:
333: Null string returns a string starting with zero
335: Not for use in Fortran
337: .seealso: PetscStrncpy(), PetscStrcat(), PetscStrlcat()
339: @*/
341: PetscErrorCode PetscStrcpy(char s[],const char t[])
342: {
344: if (t && !s) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_NULL,"Trying to copy string into null pointer");
345: if (t) strcpy(s,t);
346: else if (s) s[0] = 0;
347: return(0);
348: }
350: /*@C
351: PetscStrncpy - Copies a string up to a certain length
353: Not Collective
355: Input Parameters:
356: + t - pointer to string
357: - n - the length to copy
359: Output Parameter:
360: . s - the copied string
362: Level: intermediate
364: Note:
365: Null string returns a string starting with zero
367: If the string that is being copied is of length n or larger then the entire string is not
368: copied and the final location of s is set to NULL. This is different then the behavior of
369: strncpy() which leaves s non-terminated if there is not room for the entire string.
371: Developers Note: Should this be PetscStrlcpy() to reflect its behavior which is like strlcpy() not strncpy()
373: .seealso: PetscStrcpy(), PetscStrcat(), PetscStrlcat()
375: @*/
376: PetscErrorCode PetscStrncpy(char s[],const char t[],size_t n)
377: {
379: if (t && !s) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_NULL,"Trying to copy string into null pointer");
380: 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");
381: if (t) {
382: if (n > 1) {
383: strncpy(s,t,n-1);
384: s[n-1] = '\0';
385: } else {
386: s[0] = '\0';
387: }
388: } else if (s) s[0] = 0;
389: return(0);
390: }
392: /*@C
393: PetscStrcat - Concatenates a string onto a given string
395: Not Collective
397: Input Parameters:
398: + s - string to be added to
399: - t - pointer to string to be added to end
401: Level: intermediate
403: Notes:
404: Not for use in Fortran
406: .seealso: PetscStrcpy(), PetscStrncpy(), PetscStrlcat()
408: @*/
409: PetscErrorCode PetscStrcat(char s[],const char t[])
410: {
412: if (!t) return(0);
413: strcat(s,t);
414: return(0);
415: }
417: /*@C
418: PetscStrlcat - Concatenates a string onto a given string, up to a given length
420: Not Collective
422: Input Parameters:
423: + s - pointer to string to be added to at end
424: . t - string to be added to
425: - n - length of the original allocated string
427: Level: intermediate
429: Notes:
430: Not for use in Fortran
432: Unlike the system call strncat(), the length passed in is the length of the
433: original allocated space, not the length of the left-over space. This is
434: similar to the BSD system call strlcat().
436: .seealso: PetscStrcpy(), PetscStrncpy(), PetscStrcat()
438: @*/
439: PetscErrorCode PetscStrlcat(char s[],const char t[],size_t n)
440: {
441: size_t len;
445: if (t && !n) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ,"String buffer length must be positive");
446: if (!t) return(0);
447: PetscStrlen(t,&len);
448: strncat(s,t,n - len);
449: s[n-1] = 0;
450: return(0);
451: }
453: void PetscStrcmpNoError(const char a[],const char b[],PetscBool *flg)
454: {
455: int c;
457: if (!a && !b) *flg = PETSC_TRUE;
458: else if (!a || !b) *flg = PETSC_FALSE;
459: else {
460: c = strcmp(a,b);
461: if (c) *flg = PETSC_FALSE;
462: else *flg = PETSC_TRUE;
463: }
464: }
466: /*@C
467: PetscStrcmp - Compares two strings,
469: Not Collective
471: Input Parameters:
472: + a - pointer to string first string
473: - b - pointer to second string
475: Output Parameter:
476: . flg - PETSC_TRUE if the two strings are equal
478: Level: intermediate
480: Notes:
481: Not for use in Fortran
483: .seealso: PetscStrgrt(), PetscStrncmp(), PetscStrcasecmp()
485: @*/
486: PetscErrorCode PetscStrcmp(const char a[],const char b[],PetscBool *flg)
487: {
488: int c;
491: if (!a && !b) *flg = PETSC_TRUE;
492: else if (!a || !b) *flg = PETSC_FALSE;
493: else {
494: c = strcmp(a,b);
495: if (c) *flg = PETSC_FALSE;
496: else *flg = PETSC_TRUE;
497: }
498: return(0);
499: }
501: /*@C
502: PetscStrgrt - If first string is greater than the second
504: Not Collective
506: Input Parameters:
507: + a - pointer to first string
508: - b - pointer to second string
510: Output Parameter:
511: . flg - if the first string is greater
513: Notes:
514: Null arguments are ok, a null string is considered smaller than
515: all others
517: Not for use in Fortran
519: Level: intermediate
521: .seealso: PetscStrcmp(), PetscStrncmp(), PetscStrcasecmp()
523: @*/
524: PetscErrorCode PetscStrgrt(const char a[],const char b[],PetscBool *t)
525: {
526: int c;
529: if (!a && !b) *t = PETSC_FALSE;
530: else if (a && !b) *t = PETSC_TRUE;
531: else if (!a && b) *t = PETSC_FALSE;
532: else {
533: c = strcmp(a,b);
534: if (c > 0) *t = PETSC_TRUE;
535: else *t = PETSC_FALSE;
536: }
537: return(0);
538: }
540: /*@C
541: PetscStrcasecmp - Returns true if the two strings are the same
542: except possibly for case.
544: Not Collective
546: Input Parameters:
547: + a - pointer to first string
548: - b - pointer to second string
550: Output Parameter:
551: . flg - if the two strings are the same
553: Notes:
554: Null arguments are ok
556: Not for use in Fortran
558: Level: intermediate
560: .seealso: PetscStrcmp(), PetscStrncmp(), PetscStrgrt()
562: @*/
563: PetscErrorCode PetscStrcasecmp(const char a[],const char b[],PetscBool *t)
564: {
565: int c;
568: if (!a && !b) c = 0;
569: else if (!a || !b) c = 1;
570: #if defined(PETSC_HAVE_STRCASECMP)
571: else c = strcasecmp(a,b);
572: #elif defined(PETSC_HAVE_STRICMP)
573: else c = stricmp(a,b);
574: #else
575: else {
576: char *aa,*bb;
578: PetscStrallocpy(a,&aa);
579: PetscStrallocpy(b,&bb);
580: PetscStrtolower(aa);
581: PetscStrtolower(bb);
582: PetscStrcmp(aa,bb,t);
583: PetscFree(aa);
584: PetscFree(bb);
585: return(0);
586: }
587: #endif
588: if (!c) *t = PETSC_TRUE;
589: else *t = PETSC_FALSE;
590: return(0);
591: }
595: /*@C
596: PetscStrncmp - Compares two strings, up to a certain length
598: Not Collective
600: Input Parameters:
601: + a - pointer to first string
602: . b - pointer to second string
603: - n - length to compare up to
605: Output Parameter:
606: . t - if the two strings are equal
608: Level: intermediate
610: Notes:
611: Not for use in Fortran
613: .seealso: PetscStrgrt(), PetscStrcmp(), PetscStrcasecmp()
615: @*/
616: PetscErrorCode PetscStrncmp(const char a[],const char b[],size_t n,PetscBool *t)
617: {
618: int c;
621: c = strncmp(a,b,n);
622: if (!c) *t = PETSC_TRUE;
623: else *t = PETSC_FALSE;
624: return(0);
625: }
627: /*@C
628: PetscStrchr - Locates first occurance of a character in a string
630: Not Collective
632: Input Parameters:
633: + a - pointer to string
634: - b - character
636: Output Parameter:
637: . c - location of occurance, NULL if not found
639: Level: intermediate
641: Notes:
642: Not for use in Fortran
644: @*/
645: PetscErrorCode PetscStrchr(const char a[],char b,char *c[])
646: {
648: *c = (char*)strchr(a,b);
649: return(0);
650: }
652: /*@C
653: PetscStrrchr - Locates one location past the last occurance of a character in a string,
654: if the character is not found then returns entire string
656: Not Collective
658: Input Parameters:
659: + a - pointer to string
660: - b - character
662: Output Parameter:
663: . tmp - location of occurance, a if not found
665: Level: intermediate
667: Notes:
668: Not for use in Fortran
670: @*/
671: PetscErrorCode PetscStrrchr(const char a[],char b,char *tmp[])
672: {
674: *tmp = (char*)strrchr(a,b);
675: if (!*tmp) *tmp = (char*)a;
676: else *tmp = *tmp + 1;
677: return(0);
678: }
680: /*@C
681: PetscStrtolower - Converts string to lower case
683: Not Collective
685: Input Parameters:
686: . a - pointer to string
688: Level: intermediate
690: Notes:
691: Not for use in Fortran
693: @*/
694: PetscErrorCode PetscStrtolower(char a[])
695: {
697: while (*a) {
698: if (*a >= 'A' && *a <= 'Z') *a += 'a' - 'A';
699: a++;
700: }
701: return(0);
702: }
704: /*@C
705: PetscStrtoupper - Converts string to upper case
707: Not Collective
709: Input Parameters:
710: . a - pointer to string
712: Level: intermediate
714: Notes:
715: Not for use in Fortran
717: @*/
718: PetscErrorCode PetscStrtoupper(char a[])
719: {
721: while (*a) {
722: if (*a >= 'a' && *a <= 'z') *a += 'A' - 'a';
723: a++;
724: }
725: return(0);
726: }
728: /*@C
729: PetscStrendswith - Determines if a string ends with a certain string
731: Not Collective
733: Input Parameters:
734: + a - pointer to string
735: - b - string to endwith
737: Output Parameter:
738: . flg - PETSC_TRUE or PETSC_FALSE
740: Notes:
741: Not for use in Fortran
743: Level: intermediate
745: @*/
746: PetscErrorCode PetscStrendswith(const char a[],const char b[],PetscBool *flg)
747: {
748: char *test;
750: size_t na,nb;
753: *flg = PETSC_FALSE;
754: PetscStrrstr(a,b,&test);
755: if (test) {
756: PetscStrlen(a,&na);
757: PetscStrlen(b,&nb);
758: if (a+na-nb == test) *flg = PETSC_TRUE;
759: }
760: return(0);
761: }
763: /*@C
764: PetscStrbeginswith - Determines if a string begins with a certain string
766: Not Collective
768: Input Parameters:
769: + a - pointer to string
770: - b - string to begin with
772: Output Parameter:
773: . flg - PETSC_TRUE or PETSC_FALSE
775: Notes:
776: Not for use in Fortran
778: Level: intermediate
780: .seealso: PetscStrendswithwhich(), PetscStrendswith(), PetscStrtoupper, PetscStrtolower(), PetscStrrchr(), PetscStrchr(),
781: PetscStrncmp(), PetscStrlen(), PetscStrncmp(), PetscStrcmp()
783: @*/
784: PetscErrorCode PetscStrbeginswith(const char a[],const char b[],PetscBool *flg)
785: {
786: char *test;
790: *flg = PETSC_FALSE;
791: PetscStrrstr(a,b,&test);
792: if (test && (test == a)) *flg = PETSC_TRUE;
793: return(0);
794: }
797: /*@C
798: PetscStrendswithwhich - Determines if a string ends with one of several possible strings
800: Not Collective
802: Input Parameters:
803: + a - pointer to string
804: - bs - strings to endwith (last entry must be null)
806: Output Parameter:
807: . cnt - the index of the string it ends with or 1+the last possible index
809: Notes:
810: Not for use in Fortran
812: Level: intermediate
814: @*/
815: PetscErrorCode PetscStrendswithwhich(const char a[],const char *const *bs,PetscInt *cnt)
816: {
817: PetscBool flg;
821: *cnt = 0;
822: while (bs[*cnt]) {
823: PetscStrendswith(a,bs[*cnt],&flg);
824: if (flg) return(0);
825: *cnt += 1;
826: }
827: return(0);
828: }
830: /*@C
831: PetscStrrstr - Locates last occurance of string in another string
833: Not Collective
835: Input Parameters:
836: + a - pointer to string
837: - b - string to find
839: Output Parameter:
840: . tmp - location of occurance
842: Notes:
843: Not for use in Fortran
845: Level: intermediate
847: @*/
848: PetscErrorCode PetscStrrstr(const char a[],const char b[],char *tmp[])
849: {
850: const char *stmp = a, *ltmp = 0;
853: while (stmp) {
854: stmp = (char*)strstr(stmp,b);
855: if (stmp) {ltmp = stmp;stmp++;}
856: }
857: *tmp = (char*)ltmp;
858: return(0);
859: }
861: /*@C
862: PetscStrstr - Locates first occurance of string in another string
864: Not Collective
866: Input Parameters:
867: + haystack - string to search
868: - needle - string to find
870: Output Parameter:
871: . tmp - location of occurance, is a NULL if the string is not found
873: Notes:
874: Not for use in Fortran
876: Level: intermediate
878: @*/
879: PetscErrorCode PetscStrstr(const char haystack[],const char needle[],char *tmp[])
880: {
882: *tmp = (char*)strstr(haystack,needle);
883: return(0);
884: }
886: struct _p_PetscToken {char token;char *array;char *current;};
888: /*@C
889: PetscTokenFind - Locates next "token" in a string
891: Not Collective
893: Input Parameters:
894: . a - pointer to token
896: Output Parameter:
897: . result - location of occurance, NULL if not found
899: Notes:
901: This version is different from the system version in that
902: it allows you to pass a read-only string into the function.
904: This version also treats all characters etc. inside a double quote "
905: as a single token.
907: 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
908: second will return a null terminated y
910: 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
912: Not for use in Fortran
914: Level: intermediate
917: .seealso: PetscTokenCreate(), PetscTokenDestroy()
918: @*/
919: PetscErrorCode PetscTokenFind(PetscToken a,char *result[])
920: {
921: char *ptr = a->current,token;
924: *result = a->current;
925: if (ptr && !*ptr) {*result = 0;return(0);}
926: token = a->token;
927: if (ptr && (*ptr == '"')) {token = '"';(*result)++;ptr++;}
928: while (ptr) {
929: if (*ptr == token) {
930: *ptr++ = 0;
931: while (*ptr == a->token) ptr++;
932: a->current = ptr;
933: break;
934: }
935: if (!*ptr) {
936: a->current = 0;
937: break;
938: }
939: ptr++;
940: }
941: return(0);
942: }
944: /*@C
945: PetscTokenCreate - Creates a PetscToken used to find tokens in a string
947: Not Collective
949: Input Parameters:
950: + string - the string to look in
951: - b - the separator character
953: Output Parameter:
954: . t- the token object
956: Notes:
958: This version is different from the system version in that
959: it allows you to pass a read-only string into the function.
961: Not for use in Fortran
963: Level: intermediate
965: .seealso: PetscTokenFind(), PetscTokenDestroy()
966: @*/
967: PetscErrorCode PetscTokenCreate(const char a[],const char b,PetscToken *t)
968: {
972: PetscNew(t);
973: PetscStrallocpy(a,&(*t)->array);
975: (*t)->current = (*t)->array;
976: (*t)->token = b;
977: return(0);
978: }
980: /*@C
981: PetscTokenDestroy - Destroys a PetscToken
983: Not Collective
985: Input Parameters:
986: . a - pointer to token
988: Level: intermediate
990: Notes:
991: Not for use in Fortran
993: .seealso: PetscTokenCreate(), PetscTokenFind()
994: @*/
995: PetscErrorCode PetscTokenDestroy(PetscToken *a)
996: {
1000: if (!*a) return(0);
1001: PetscFree((*a)->array);
1002: PetscFree(*a);
1003: return(0);
1004: }
1006: /*@C
1007: PetscStrInList - search string in character-delimited list
1009: Not Collective
1011: Input Parameters:
1012: + str - the string to look for
1013: . list - the list to search in
1014: - sep - the separator character
1016: Output Parameter:
1017: . found - whether str is in list
1019: Level: intermediate
1021: Notes:
1022: Not for use in Fortran
1024: .seealso: PetscTokenCreate(), PetscTokenFind(), PetscStrcmp()
1025: @*/
1026: PetscErrorCode PetscStrInList(const char str[],const char list[],char sep,PetscBool *found)
1027: {
1028: PetscToken token;
1029: char *item;
1033: *found = PETSC_FALSE;
1034: PetscTokenCreate(list,sep,&token);
1035: PetscTokenFind(token,&item);
1036: while (item) {
1037: PetscStrcmp(str,item,found);
1038: if (*found) break;
1039: PetscTokenFind(token,&item);
1040: }
1041: PetscTokenDestroy(&token);
1042: return(0);
1043: }
1045: /*@C
1046: PetscGetPetscDir - Gets the directory PETSc is installed in
1048: Not Collective
1050: Output Parameter:
1051: . dir - the directory
1053: Level: developer
1055: Notes:
1056: Not for use in Fortran
1058: @*/
1059: PetscErrorCode PetscGetPetscDir(const char *dir[])
1060: {
1062: *dir = PETSC_DIR;
1063: return(0);
1064: }
1066: /*@C
1067: PetscStrreplace - Replaces substrings in string with other substrings
1069: Not Collective
1071: Input Parameters:
1072: + comm - MPI_Comm of processors that are processing the string
1073: . aa - the string to look in
1074: . b - the resulting copy of a with replaced strings (b can be the same as a)
1075: - len - the length of b
1077: Notes:
1078: Replaces ${PETSC_ARCH},${PETSC_DIR},${PETSC_LIB_DIR},${DISPLAY},
1079: ${HOMEDIRECTORY},${WORKINGDIRECTORY},${USERNAME}, ${HOSTNAME} with appropriate values
1080: as well as any environmental variables.
1082: PETSC_LIB_DIR uses the environmental variable if it exists. PETSC_ARCH and PETSC_DIR use what
1083: PETSc was built with and do not use environmental variables.
1085: Not for use in Fortran
1087: Level: intermediate
1089: @*/
1090: PetscErrorCode PetscStrreplace(MPI_Comm comm,const char aa[],char b[],size_t len)
1091: {
1093: int i = 0;
1094: size_t l,l1,l2,l3;
1095: char *work,*par,*epar,env[1024],*tfree,*a = (char*)aa;
1096: const char *s[] = {"${PETSC_ARCH}","${PETSC_DIR}","${PETSC_LIB_DIR}","${DISPLAY}","${HOMEDIRECTORY}","${WORKINGDIRECTORY}","${USERNAME}","${HOSTNAME}",0};
1097: char *r[] = {0,0,0,0,0,0,0,0,0};
1098: PetscBool flag;
1101: if (!a || !b) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_NULL,"a and b strings must be nonnull");
1102: if (aa == b) {
1103: PetscStrallocpy(aa,(char**)&a);
1104: }
1105: PetscMalloc1(len,&work);
1107: /* get values for replaced variables */
1108: PetscStrallocpy(PETSC_ARCH,&r[0]);
1109: PetscStrallocpy(PETSC_DIR,&r[1]);
1110: PetscStrallocpy(PETSC_LIB_DIR,&r[2]);
1111: PetscMalloc1(256,&r[3]);
1112: PetscMalloc1(PETSC_MAX_PATH_LEN,&r[4]);
1113: PetscMalloc1(PETSC_MAX_PATH_LEN,&r[5]);
1114: PetscMalloc1(256,&r[6]);
1115: PetscMalloc1(256,&r[7]);
1116: PetscGetDisplay(r[3],256);
1117: PetscGetHomeDirectory(r[4],PETSC_MAX_PATH_LEN);
1118: PetscGetWorkingDirectory(r[5],PETSC_MAX_PATH_LEN);
1119: PetscGetUserName(r[6],256);
1120: PetscGetHostName(r[7],256);
1122: /* replace that are in environment */
1123: PetscOptionsGetenv(comm,"PETSC_LIB_DIR",env,1024,&flag);
1124: if (flag) {
1125: PetscFree(r[2]);
1126: PetscStrallocpy(env,&r[2]);
1127: }
1129: /* replace the requested strings */
1130: PetscStrncpy(b,a,len);
1131: while (s[i]) {
1132: PetscStrlen(s[i],&l);
1133: PetscStrstr(b,s[i],&par);
1134: while (par) {
1135: *par = 0;
1136: par += l;
1138: PetscStrlen(b,&l1);
1139: PetscStrlen(r[i],&l2);
1140: PetscStrlen(par,&l3);
1141: if (l1 + l2 + l3 >= len) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ,"b len is not long enough to hold new values");
1142: PetscStrcpy(work,b);
1143: PetscStrcat(work,r[i]);
1144: PetscStrcat(work,par);
1145: PetscStrncpy(b,work,len);
1146: PetscStrstr(b,s[i],&par);
1147: }
1148: i++;
1149: }
1150: i = 0;
1151: while (r[i]) {
1152: tfree = (char*)r[i];
1153: PetscFree(tfree);
1154: i++;
1155: }
1157: /* look for any other ${xxx} strings to replace from environmental variables */
1158: PetscStrstr(b,"${",&par);
1159: while (par) {
1160: *par = 0;
1161: par += 2;
1162: PetscStrcpy(work,b);
1163: PetscStrstr(par,"}",&epar);
1164: *epar = 0;
1165: epar += 1;
1166: PetscOptionsGetenv(comm,par,env,256,&flag);
1167: if (!flag) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"Substitution string ${%s} not found as environmental variable",par);
1168: PetscStrcat(work,env);
1169: PetscStrcat(work,epar);
1170: PetscStrcpy(b,work);
1171: PetscStrstr(b,"${",&par);
1172: }
1173: PetscFree(work);
1174: if (aa == b) {
1175: PetscFree(a);
1176: }
1177: return(0);
1178: }
1180: /*@C
1181: PetscEListFind - searches list of strings for given string, using case insensitive matching
1183: Not Collective
1185: Input Parameters:
1186: + n - number of strings in
1187: . list - list of strings to search
1188: - str - string to look for, empty string "" accepts default (first entry in list)
1190: Output Parameters:
1191: + value - index of matching string (if found)
1192: - found - boolean indicating whether string was found (can be NULL)
1194: Notes:
1195: Not for use in Fortran
1197: Level: advanced
1198: @*/
1199: PetscErrorCode PetscEListFind(PetscInt n,const char *const *list,const char *str,PetscInt *value,PetscBool *found)
1200: {
1202: PetscBool matched;
1203: PetscInt i;
1206: if (found) *found = PETSC_FALSE;
1207: for (i=0; i<n; i++) {
1208: PetscStrcasecmp(str,list[i],&matched);
1209: if (matched || !str[0]) {
1210: if (found) *found = PETSC_TRUE;
1211: *value = i;
1212: break;
1213: }
1214: }
1215: return(0);
1216: }
1218: /*@C
1219: PetscEnumFind - searches enum list of strings for given string, using case insensitive matching
1221: Not Collective
1223: Input Parameters:
1224: + enumlist - list of strings to search, followed by enum name, then enum prefix, then NUL
1225: - str - string to look for
1227: Output Parameters:
1228: + value - index of matching string (if found)
1229: - found - boolean indicating whether string was found (can be NULL)
1231: Notes:
1232: Not for use in Fortran
1234: Level: advanced
1235: @*/
1236: PetscErrorCode PetscEnumFind(const char *const *enumlist,const char *str,PetscEnum *value,PetscBool *found)
1237: {
1239: PetscInt n = 0,evalue;
1240: PetscBool efound;
1243: 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");
1244: if (n < 3) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"List argument must have at least two entries: typename and type prefix");
1245: n -= 3; /* drop enum name, prefix, and null termination */
1246: PetscEListFind(n,enumlist,str,&evalue,&efound);
1247: if (efound) *value = (PetscEnum)evalue;
1248: if (found) *found = efound;
1249: return(0);
1250: }