Actual source code: str.c
petsc-3.9.4 2018-09-11
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_STRING_H)
10: #include <string.h> /* strstr */
11: #endif
12: #if defined(PETSC_HAVE_STRINGS_H)
13: # include <strings.h> /* strcasecmp */
14: #endif
16: /*@C
17: PetscStrToArray - Separates a string by a charactor (for example ' ' or '\n') and creates an array of strings
19: Not Collective
21: Input Parameters:
22: + s - pointer to string
23: - sp - separator charactor
25: Output Parameter:
26: + argc - the number of entries in the array
27: - args - an array of the entries with a null at the end
29: Level: intermediate
31: Notes: this may be called before PetscInitialize() or after PetscFinalize()
33: Not for use in Fortran
35: Developer Notes: Using raw malloc() and does not call error handlers since this may be used before PETSc is initialized. Used
36: to generate argc, args arguments passed to MPI_Init()
38: .seealso: PetscStrToArrayDestroy(), PetscToken, PetscTokenCreate()
40: @*/
41: PetscErrorCode PetscStrToArray(const char s[],char sp,int *argc,char ***args)
42: {
43: int i,j,n,*lens,cnt = 0;
44: PetscBool flg = PETSC_FALSE;
46: if (!s) n = 0;
47: else n = strlen(s);
48: *argc = 0;
49: *args = NULL;
50: for (; n>0; n--) { /* remove separator chars at the end - and will empty the string if all chars are separator chars */
51: if (s[n-1] != sp) break;
52: }
53: if (!n) {
54: return(0);
55: }
56: for (i=0; i<n; i++) {
57: if (s[i] != sp) break;
58: }
59: for (;i<n+1; i++) {
60: if ((s[i] == sp || s[i] == 0) && !flg) {flg = PETSC_TRUE; (*argc)++;}
61: else if (s[i] != sp) {flg = PETSC_FALSE;}
62: }
63: (*args) = (char**) malloc(((*argc)+1)*sizeof(char*)); if (!*args) return PETSC_ERR_MEM;
64: lens = (int*) malloc((*argc)*sizeof(int)); if (!lens) return PETSC_ERR_MEM;
65: for (i=0; i<*argc; i++) lens[i] = 0;
67: *argc = 0;
68: for (i=0; i<n; i++) {
69: if (s[i] != sp) break;
70: }
71: for (;i<n+1; i++) {
72: if ((s[i] == sp || s[i] == 0) && !flg) {flg = PETSC_TRUE; (*argc)++;}
73: else if (s[i] != sp) {lens[*argc]++;flg = PETSC_FALSE;}
74: }
76: for (i=0; i<*argc; i++) {
77: (*args)[i] = (char*) malloc((lens[i]+1)*sizeof(char));
78: if (!(*args)[i]) {
79: free(lens);
80: for (j=0; j<i; j++) free((*args)[j]);
81: free(*args);
82: return PETSC_ERR_MEM;
83: }
84: }
85: free(lens);
86: (*args)[*argc] = 0;
88: *argc = 0;
89: for (i=0; i<n; i++) {
90: if (s[i] != sp) break;
91: }
92: for (;i<n+1; i++) {
93: if ((s[i] == sp || s[i] == 0) && !flg) {flg = PETSC_TRUE; (*args)[*argc][cnt++] = 0; (*argc)++; cnt = 0;}
94: else if (s[i] != sp && s[i] != 0) {(*args)[*argc][cnt++] = s[i]; flg = PETSC_FALSE;}
95: }
96: return 0;
97: }
99: /*@C
100: PetscStrToArrayDestroy - Frees array created with PetscStrToArray().
102: Not Collective
104: Output Parameters:
105: + argc - the number of arguments
106: - args - the array of arguments
108: Level: intermediate
110: Concepts: command line arguments
112: Notes: This may be called before PetscInitialize() or after PetscFinalize()
114: Not for use in Fortran
116: .seealso: PetscStrToArray()
118: @*/
119: PetscErrorCode PetscStrToArrayDestroy(int argc,char **args)
120: {
121: PetscInt i;
123: for (i=0; i<argc; i++) free(args[i]);
124: if (args) free(args);
125: return 0;
126: }
128: /*@C
129: PetscStrlen - Gets length of a string
131: Not Collective
133: Input Parameters:
134: . s - pointer to string
136: Output Parameter:
137: . len - length in bytes
139: Level: intermediate
141: Note:
142: This routine is analogous to strlen().
144: Null string returns a length of zero
146: Not for use in Fortran
148: Concepts: string length
150: @*/
151: PetscErrorCode PetscStrlen(const char s[],size_t *len)
152: {
154: if (!s) *len = 0;
155: else *len = strlen(s);
156: return(0);
157: }
159: /*@C
160: PetscStrallocpy - Allocates space to hold a copy of a string then copies the string
162: Not Collective
164: Input Parameters:
165: . s - pointer to string
167: Output Parameter:
168: . t - the copied string
170: Level: intermediate
172: Note:
173: Null string returns a new null string
175: Not for use in Fortran
177: Concepts: string copy
179: @*/
180: PetscErrorCode PetscStrallocpy(const char s[],char *t[])
181: {
183: size_t len;
184: char *tmp = 0;
187: if (s) {
188: PetscStrlen(s,&len);
189: PetscMalloc1(1+len,&tmp);
190: PetscStrcpy(tmp,s);
191: }
192: *t = tmp;
193: return(0);
194: }
196: /*@C
197: PetscStrArrayallocpy - Allocates space to hold a copy of an array of strings then copies the strings
199: Not Collective
201: Input Parameters:
202: . s - pointer to array of strings (final string is a null)
204: Output Parameter:
205: . t - the copied array string
207: Level: intermediate
209: Note:
210: Not for use in Fortran
212: Concepts: string copy
214: .seealso: PetscStrallocpy() PetscStrArrayDestroy()
216: @*/
217: PetscErrorCode PetscStrArrayallocpy(const char *const *list,char ***t)
218: {
220: PetscInt i,n = 0;
223: while (list[n++]) ;
224: PetscMalloc1(n+1,t);
225: for (i=0; i<n; i++) {
226: PetscStrallocpy(list[i],(*t)+i);
227: }
228: (*t)[n] = NULL;
229: return(0);
230: }
232: /*@C
233: PetscStrArrayDestroy - Frees array of strings created with PetscStrArrayallocpy().
235: Not Collective
237: Output Parameters:
238: . list - array of strings
240: Level: intermediate
242: Concepts: command line arguments
244: Notes: Not for use in Fortran
246: .seealso: PetscStrArrayallocpy()
248: @*/
249: PetscErrorCode PetscStrArrayDestroy(char ***list)
250: {
251: PetscInt n = 0;
255: if (!*list) return(0);
256: while ((*list)[n]) {
257: PetscFree((*list)[n]);
258: n++;
259: }
260: PetscFree(*list);
261: return(0);
262: }
264: /*@C
265: PetscStrNArrayallocpy - Allocates space to hold a copy of an array of strings then copies the strings
267: Not Collective
269: Input Parameters:
270: + n - the number of string entries
271: - s - pointer to array of strings
273: Output Parameter:
274: . t - the copied array string
276: Level: intermediate
278: Note:
279: Not for use in Fortran
281: Concepts: string copy
283: .seealso: PetscStrallocpy() PetscStrArrayDestroy()
285: @*/
286: PetscErrorCode PetscStrNArrayallocpy(PetscInt n,const char *const *list,char ***t)
287: {
289: PetscInt i;
292: PetscMalloc1(n,t);
293: for (i=0; i<n; i++) {
294: PetscStrallocpy(list[i],(*t)+i);
295: }
296: return(0);
297: }
299: /*@C
300: PetscStrNArrayDestroy - Frees array of strings created with PetscStrArrayallocpy().
302: Not Collective
304: Output Parameters:
305: + n - number of string entries
306: - list - array of strings
308: Level: intermediate
310: Notes: Not for use in Fortran
312: .seealso: PetscStrArrayallocpy()
314: @*/
315: PetscErrorCode PetscStrNArrayDestroy(PetscInt n,char ***list)
316: {
318: PetscInt i;
321: if (!*list) return(0);
322: for (i=0; i<n; i++){
323: PetscFree((*list)[i]);
324: }
325: PetscFree(*list);
326: return(0);
327: }
329: /*@C
330: PetscStrcpy - Copies a string
332: Not Collective
334: Input Parameters:
335: . t - pointer to string
337: Output Parameter:
338: . s - the copied string
340: Level: intermediate
342: Notes:
343: Null string returns a string starting with zero
345: Not for use in Fortran
347: Concepts: string copy
349: .seealso: PetscStrncpy(), PetscStrcat(), PetscStrlcat()
351: @*/
353: PetscErrorCode PetscStrcpy(char s[],const char t[])
354: {
356: if (t && !s) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_NULL,"Trying to copy string into null pointer");
357: if (t) strcpy(s,t);
358: else if (s) s[0] = 0;
359: return(0);
360: }
362: /*@C
363: PetscStrncpy - Copies a string up to a certain length
365: Not Collective
367: Input Parameters:
368: + t - pointer to string
369: - n - the length to copy
371: Output Parameter:
372: . s - the copied string
374: Level: intermediate
376: Note:
377: Null string returns a string starting with zero
379: If the string that is being copied is of length n or larger then the entire string is not
380: copied and the file location of s is set to NULL. This is different then the behavior of
381: strncpy() which leaves s non-terminated.
383: Concepts: string copy
385: .seealso: PetscStrcpy(), PetscStrcat(), PetscStrlcat()
387: @*/
388: PetscErrorCode PetscStrncpy(char s[],const char t[],size_t n)
389: {
391: if (t && !s) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_NULL,"Trying to copy string into null pointer");
392: if (t) {
393: if (n > 1) {
394: strncpy(s,t,n-1);
395: s[n-1] = '\0';
396: } else {
397: s[0] = '\0';
398: }
399: } else if (s) s[0] = 0;
400: return(0);
401: }
403: /*@C
404: PetscStrcat - Concatenates a string onto a given string
406: Not Collective
408: Input Parameters:
409: + s - string to be added to
410: - t - pointer to string to be added to end
412: Level: intermediate
414: Notes: Not for use in Fortran
416: Concepts: string copy
418: .seealso: PetscStrcpy(), PetscStrncpy(), PetscStrlcat()
420: @*/
421: PetscErrorCode PetscStrcat(char s[],const char t[])
422: {
424: if (!t) return(0);
425: strcat(s,t);
426: return(0);
427: }
429: /*@C
430: PetscStrlcat - Concatenates a string onto a given string, up to a given length
432: Not Collective
434: Input Parameters:
435: + s - pointer to string to be added to end
436: . t - string to be added to
437: - n - length of the original allocated string
439: Level: intermediate
441: Notes:
442: Not for use in Fortran
444: Unlike the system call strncat(), the length passed in is the length of the
445: original allocated space, not the length of the left-over space. This is
446: similar to the BSD system call strlcat().
448: Concepts: string copy
450: .seealso: PetscStrcpy(), PetscStrncpy(), PetscStrcat()
452: @*/
453: PetscErrorCode PetscStrlcat(char s[],const char t[],size_t n)
454: {
455: size_t len;
459: if (t && !n) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ,"String buffer length must be positive");
460: PetscStrlen(t,&len);
461: strncat(s,t,n - len);
462: s[n-1] = 0;
463: return(0);
464: }
466: /*
469: */
470: void PetscStrcmpNoError(const char a[],const char b[],PetscBool *flg)
471: {
472: int c;
474: if (!a && !b) *flg = PETSC_TRUE;
475: else if (!a || !b) *flg = PETSC_FALSE;
476: else {
477: c = strcmp(a,b);
478: if (c) *flg = PETSC_FALSE;
479: else *flg = PETSC_TRUE;
480: }
481: }
483: /*@C
484: PetscStrcmp - Compares two strings,
486: Not Collective
488: Input Parameters:
489: + a - pointer to string first string
490: - b - pointer to second string
492: Output Parameter:
493: . flg - PETSC_TRUE if the two strings are equal
495: Level: intermediate
497: Notes: Not for use in Fortran
499: .seealso: PetscStrgrt(), PetscStrncmp(), PetscStrcasecmp()
501: @*/
502: PetscErrorCode PetscStrcmp(const char a[],const char b[],PetscBool *flg)
503: {
504: int c;
507: if (!a && !b) *flg = PETSC_TRUE;
508: else if (!a || !b) *flg = PETSC_FALSE;
509: else {
510: c = strcmp(a,b);
511: if (c) *flg = PETSC_FALSE;
512: else *flg = PETSC_TRUE;
513: }
514: return(0);
515: }
517: /*@C
518: PetscStrgrt - If first string is greater than the second
520: Not Collective
522: Input Parameters:
523: + a - pointer to first string
524: - b - pointer to second string
526: Output Parameter:
527: . flg - if the first string is greater
529: Notes:
530: Null arguments are ok, a null string is considered smaller than
531: all others
533: Not for use in Fortran
535: Level: intermediate
537: .seealso: PetscStrcmp(), PetscStrncmp(), PetscStrcasecmp()
539: @*/
540: PetscErrorCode PetscStrgrt(const char a[],const char b[],PetscBool *t)
541: {
542: int c;
545: if (!a && !b) *t = PETSC_FALSE;
546: else if (a && !b) *t = PETSC_TRUE;
547: else if (!a && b) *t = PETSC_FALSE;
548: else {
549: c = strcmp(a,b);
550: if (c > 0) *t = PETSC_TRUE;
551: else *t = PETSC_FALSE;
552: }
553: return(0);
554: }
556: /*@C
557: PetscStrcasecmp - Returns true if the two strings are the same
558: except possibly for case.
560: Not Collective
562: Input Parameters:
563: + a - pointer to first string
564: - b - pointer to second string
566: Output Parameter:
567: . flg - if the two strings are the same
569: Notes:
570: Null arguments are ok
572: Not for use in Fortran
574: Level: intermediate
576: .seealso: PetscStrcmp(), PetscStrncmp(), PetscStrgrt()
578: @*/
579: PetscErrorCode PetscStrcasecmp(const char a[],const char b[],PetscBool *t)
580: {
581: int c;
584: if (!a && !b) c = 0;
585: else if (!a || !b) c = 1;
586: #if defined(PETSC_HAVE_STRCASECMP)
587: else c = strcasecmp(a,b);
588: #elif defined(PETSC_HAVE_STRICMP)
589: else c = stricmp(a,b);
590: #else
591: else {
592: char *aa,*bb;
594: PetscStrallocpy(a,&aa);
595: PetscStrallocpy(b,&bb);
596: PetscStrtolower(aa);
597: PetscStrtolower(bb);
598: PetscStrcmp(aa,bb,t);
599: PetscFree(aa);
600: PetscFree(bb);
601: return(0);
602: }
603: #endif
604: if (!c) *t = PETSC_TRUE;
605: else *t = PETSC_FALSE;
606: return(0);
607: }
611: /*@C
612: PetscStrncmp - Compares two strings, up to a certain length
614: Not Collective
616: Input Parameters:
617: + a - pointer to first string
618: . b - pointer to second string
619: - n - length to compare up to
621: Output Parameter:
622: . t - if the two strings are equal
624: Level: intermediate
626: Notes: Not for use in Fortran
628: .seealso: PetscStrgrt(), PetscStrcmp(), PetscStrcasecmp()
630: @*/
631: PetscErrorCode PetscStrncmp(const char a[],const char b[],size_t n,PetscBool *t)
632: {
633: int c;
636: c = strncmp(a,b,n);
637: if (!c) *t = PETSC_TRUE;
638: else *t = PETSC_FALSE;
639: return(0);
640: }
642: /*@C
643: PetscStrchr - Locates first occurance of a character in a string
645: Not Collective
647: Input Parameters:
648: + a - pointer to string
649: - b - character
651: Output Parameter:
652: . c - location of occurance, NULL if not found
654: Level: intermediate
656: Notes: Not for use in Fortran
658: @*/
659: PetscErrorCode PetscStrchr(const char a[],char b,char *c[])
660: {
662: *c = (char*)strchr(a,b);
663: return(0);
664: }
666: /*@C
667: PetscStrrchr - Locates one location past the last occurance of a character in a string,
668: if the character is not found then returns entire string
670: Not Collective
672: Input Parameters:
673: + a - pointer to string
674: - b - character
676: Output Parameter:
677: . tmp - location of occurance, a if not found
679: Level: intermediate
681: Notes: Not for use in Fortran
683: @*/
684: PetscErrorCode PetscStrrchr(const char a[],char b,char *tmp[])
685: {
687: *tmp = (char*)strrchr(a,b);
688: if (!*tmp) *tmp = (char*)a;
689: else *tmp = *tmp + 1;
690: return(0);
691: }
693: /*@C
694: PetscStrtolower - Converts string to lower case
696: Not Collective
698: Input Parameters:
699: . a - pointer to string
701: Level: intermediate
703: Notes: Not for use in Fortran
705: @*/
706: PetscErrorCode PetscStrtolower(char a[])
707: {
709: while (*a) {
710: if (*a >= 'A' && *a <= 'Z') *a += 'a' - 'A';
711: a++;
712: }
713: return(0);
714: }
716: /*@C
717: PetscStrtoupper - Converts string to upper case
719: Not Collective
721: Input Parameters:
722: . a - pointer to string
724: Level: intermediate
726: Notes: Not for use in Fortran
728: @*/
729: PetscErrorCode PetscStrtoupper(char a[])
730: {
732: while (*a) {
733: if (*a >= 'a' && *a <= 'z') *a += 'A' - 'a';
734: a++;
735: }
736: return(0);
737: }
739: /*@C
740: PetscStrendswith - Determines if a string ends with a certain string
742: Not Collective
744: Input Parameters:
745: + a - pointer to string
746: - b - string to endwith
748: Output Parameter:
749: . flg - PETSC_TRUE or PETSC_FALSE
751: Notes: Not for use in Fortran
753: Level: intermediate
755: @*/
756: PetscErrorCode PetscStrendswith(const char a[],const char b[],PetscBool *flg)
757: {
758: char *test;
760: size_t na,nb;
763: *flg = PETSC_FALSE;
764: PetscStrrstr(a,b,&test);
765: if (test) {
766: PetscStrlen(a,&na);
767: PetscStrlen(b,&nb);
768: if (a+na-nb == test) *flg = PETSC_TRUE;
769: }
770: return(0);
771: }
773: /*@C
774: PetscStrbeginswith - Determines if a string begins with a certain string
776: Not Collective
778: Input Parameters:
779: + a - pointer to string
780: - b - string to begin with
782: Output Parameter:
783: . flg - PETSC_TRUE or PETSC_FALSE
785: Notes: Not for use in Fortran
787: Level: intermediate
789: .seealso: PetscStrendswithwhich(), PetscStrendswith(), PetscStrtoupper, PetscStrtolower(), PetscStrrchr(), PetscStrchr(),
790: PetscStrncmp(), PetscStrlen(), PetscStrncmp(), PetscStrcmp()
792: @*/
793: PetscErrorCode PetscStrbeginswith(const char a[],const char b[],PetscBool *flg)
794: {
795: char *test;
799: *flg = PETSC_FALSE;
800: PetscStrrstr(a,b,&test);
801: if (test && (test == a)) *flg = PETSC_TRUE;
802: return(0);
803: }
806: /*@C
807: PetscStrendswithwhich - Determines if a string ends with one of several possible strings
809: Not Collective
811: Input Parameters:
812: + a - pointer to string
813: - bs - strings to endwith (last entry must be null)
815: Output Parameter:
816: . cnt - the index of the string it ends with or 1+the last possible index
818: Notes: Not for use in Fortran
820: Level: intermediate
822: @*/
823: PetscErrorCode PetscStrendswithwhich(const char a[],const char *const *bs,PetscInt *cnt)
824: {
825: PetscBool flg;
829: *cnt = 0;
830: while (bs[*cnt]) {
831: PetscStrendswith(a,bs[*cnt],&flg);
832: if (flg) return(0);
833: *cnt += 1;
834: }
835: return(0);
836: }
838: /*@C
839: PetscStrrstr - Locates last occurance of string in another string
841: Not Collective
843: Input Parameters:
844: + a - pointer to string
845: - b - string to find
847: Output Parameter:
848: . tmp - location of occurance
850: Notes: Not for use in Fortran
852: Level: intermediate
854: @*/
855: PetscErrorCode PetscStrrstr(const char a[],const char b[],char *tmp[])
856: {
857: const char *stmp = a, *ltmp = 0;
860: while (stmp) {
861: stmp = (char*)strstr(stmp,b);
862: if (stmp) {ltmp = stmp;stmp++;}
863: }
864: *tmp = (char*)ltmp;
865: return(0);
866: }
868: /*@C
869: PetscStrstr - Locates first occurance of string in another string
871: Not Collective
873: Input Parameters:
874: + haystack - string to search
875: - needle - string to find
877: Output Parameter:
878: . tmp - location of occurance, is a NULL if the string is not found
880: Notes: Not for use in Fortran
882: Level: intermediate
884: @*/
885: PetscErrorCode PetscStrstr(const char haystack[],const char needle[],char *tmp[])
886: {
888: *tmp = (char*)strstr(haystack,needle);
889: return(0);
890: }
892: struct _p_PetscToken {char token;char *array;char *current;};
894: /*@C
895: PetscTokenFind - Locates next "token" in a string
897: Not Collective
899: Input Parameters:
900: . a - pointer to token
902: Output Parameter:
903: . result - location of occurance, NULL if not found
905: Notes:
907: This version is different from the system version in that
908: it allows you to pass a read-only string into the function.
910: This version also treats all characters etc. inside a double quote "
911: as a single token.
913: 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
914: second will return a null terminated y
916: 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
918: Not for use in Fortran
920: Level: intermediate
923: .seealso: PetscTokenCreate(), PetscTokenDestroy()
924: @*/
925: PetscErrorCode PetscTokenFind(PetscToken a,char *result[])
926: {
927: char *ptr = a->current,token;
930: *result = a->current;
931: if (ptr && !*ptr) {*result = 0;return(0);}
932: token = a->token;
933: if (ptr && (*ptr == '"')) {token = '"';(*result)++;ptr++;}
934: while (ptr) {
935: if (*ptr == token) {
936: *ptr++ = 0;
937: while (*ptr == a->token) ptr++;
938: a->current = ptr;
939: break;
940: }
941: if (!*ptr) {
942: a->current = 0;
943: break;
944: }
945: ptr++;
946: }
947: return(0);
948: }
950: /*@C
951: PetscTokenCreate - Creates a PetscToken used to find tokens in a string
953: Not Collective
955: Input Parameters:
956: + string - the string to look in
957: - b - the separator character
959: Output Parameter:
960: . t- the token object
962: Notes:
964: This version is different from the system version in that
965: it allows you to pass a read-only string into the function.
967: Not for use in Fortran
969: Level: intermediate
971: .seealso: PetscTokenFind(), PetscTokenDestroy()
972: @*/
973: PetscErrorCode PetscTokenCreate(const char a[],const char b,PetscToken *t)
974: {
978: PetscNew(t);
979: PetscStrallocpy(a,&(*t)->array);
981: (*t)->current = (*t)->array;
982: (*t)->token = b;
983: return(0);
984: }
986: /*@C
987: PetscTokenDestroy - Destroys a PetscToken
989: Not Collective
991: Input Parameters:
992: . a - pointer to token
994: Level: intermediate
996: Notes: Not for use in Fortran
998: .seealso: PetscTokenCreate(), PetscTokenFind()
999: @*/
1000: PetscErrorCode PetscTokenDestroy(PetscToken *a)
1001: {
1005: if (!*a) return(0);
1006: PetscFree((*a)->array);
1007: PetscFree(*a);
1008: return(0);
1009: }
1011: /*@C
1012: PetscStrInList - search string in character-delimited list
1014: Not Collective
1016: Input Parameters:
1017: + str - the string to look for
1018: . list - the list to search in
1019: - sep - the separator character
1021: Output Parameter:
1022: . found - whether str is in list
1024: Level: intermediate
1026: Notes: Not for use in Fortran
1028: .seealso: PetscTokenCreate(), PetscTokenFind(), PetscStrcmp()
1029: @*/
1030: PetscErrorCode PetscStrInList(const char str[],const char list[],char sep,PetscBool *found)
1031: {
1032: PetscToken token;
1033: char *item;
1037: *found = PETSC_FALSE;
1038: PetscTokenCreate(list,sep,&token);
1039: PetscTokenFind(token,&item);
1040: while (item) {
1041: PetscStrcmp(str,item,found);
1042: if (*found) break;
1043: PetscTokenFind(token,&item);
1044: }
1045: PetscTokenDestroy(&token);
1046: return(0);
1047: }
1049: /*@C
1050: PetscGetPetscDir - Gets the directory PETSc is installed in
1052: Not Collective
1054: Output Parameter:
1055: . dir - the directory
1057: Level: developer
1059: Notes: Not for use in Fortran
1061: @*/
1062: PetscErrorCode PetscGetPetscDir(const char *dir[])
1063: {
1065: *dir = PETSC_DIR;
1066: return(0);
1067: }
1069: /*@C
1070: PetscStrreplace - Replaces substrings in string with other substrings
1072: Not Collective
1074: Input Parameters:
1075: + comm - MPI_Comm of processors that are processing the string
1076: . aa - the string to look in
1077: . b - the resulting copy of a with replaced strings (b can be the same as a)
1078: - len - the length of b
1080: Notes:
1081: Replaces ${PETSC_ARCH},${PETSC_DIR},${PETSC_LIB_DIR},${DISPLAY},
1082: ${HOMEDIRECTORY},${WORKINGDIRECTORY},${USERNAME}, ${HOSTNAME} with appropriate values
1083: as well as any environmental variables.
1085: PETSC_LIB_DIR uses the environmental variable if it exists. PETSC_ARCH and PETSC_DIR use what
1086: PETSc was built with and do not use environmental variables.
1088: Not for use in Fortran
1090: Level: intermediate
1092: @*/
1093: PetscErrorCode PetscStrreplace(MPI_Comm comm,const char aa[],char b[],size_t len)
1094: {
1096: int i = 0;
1097: size_t l,l1,l2,l3;
1098: char *work,*par,*epar,env[1024],*tfree,*a = (char*)aa;
1099: const char *s[] = {"${PETSC_ARCH}","${PETSC_DIR}","${PETSC_LIB_DIR}","${DISPLAY}","${HOMEDIRECTORY}","${WORKINGDIRECTORY}","${USERNAME}","${HOSTNAME}",0};
1100: char *r[] = {0,0,0,0,0,0,0,0,0};
1101: PetscBool flag;
1104: if (!a || !b) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_NULL,"a and b strings must be nonnull");
1105: if (aa == b) {
1106: PetscStrallocpy(aa,(char**)&a);
1107: }
1108: PetscMalloc1(len,&work);
1110: /* get values for replaced variables */
1111: PetscStrallocpy(PETSC_ARCH,&r[0]);
1112: PetscStrallocpy(PETSC_DIR,&r[1]);
1113: PetscStrallocpy(PETSC_LIB_DIR,&r[2]);
1114: PetscMalloc1(256,&r[3]);
1115: PetscMalloc1(PETSC_MAX_PATH_LEN,&r[4]);
1116: PetscMalloc1(PETSC_MAX_PATH_LEN,&r[5]);
1117: PetscMalloc1(256,&r[6]);
1118: PetscMalloc1(256,&r[7]);
1119: PetscGetDisplay(r[3],256);
1120: PetscGetHomeDirectory(r[4],PETSC_MAX_PATH_LEN);
1121: PetscGetWorkingDirectory(r[5],PETSC_MAX_PATH_LEN);
1122: PetscGetUserName(r[6],256);
1123: PetscGetHostName(r[7],256);
1125: /* replace that are in environment */
1126: PetscOptionsGetenv(comm,"PETSC_LIB_DIR",env,1024,&flag);
1127: if (flag) {
1128: PetscFree(r[2]);
1129: PetscStrallocpy(env,&r[2]);
1130: }
1132: /* replace the requested strings */
1133: PetscStrncpy(b,a,len);
1134: while (s[i]) {
1135: PetscStrlen(s[i],&l);
1136: PetscStrstr(b,s[i],&par);
1137: while (par) {
1138: *par = 0;
1139: par += l;
1141: PetscStrlen(b,&l1);
1142: PetscStrlen(r[i],&l2);
1143: PetscStrlen(par,&l3);
1144: if (l1 + l2 + l3 >= len) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ,"b len is not long enough to hold new values");
1145: PetscStrcpy(work,b);
1146: PetscStrcat(work,r[i]);
1147: PetscStrcat(work,par);
1148: PetscStrncpy(b,work,len);
1149: PetscStrstr(b,s[i],&par);
1150: }
1151: i++;
1152: }
1153: i = 0;
1154: while (r[i]) {
1155: tfree = (char*)r[i];
1156: PetscFree(tfree);
1157: i++;
1158: }
1160: /* look for any other ${xxx} strings to replace from environmental variables */
1161: PetscStrstr(b,"${",&par);
1162: while (par) {
1163: *par = 0;
1164: par += 2;
1165: PetscStrcpy(work,b);
1166: PetscStrstr(par,"}",&epar);
1167: *epar = 0;
1168: epar += 1;
1169: PetscOptionsGetenv(comm,par,env,256,&flag);
1170: if (!flag) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"Substitution string ${%s} not found as environmental variable",par);
1171: PetscStrcat(work,env);
1172: PetscStrcat(work,epar);
1173: PetscStrcpy(b,work);
1174: PetscStrstr(b,"${",&par);
1175: }
1176: PetscFree(work);
1177: if (aa == b) {
1178: PetscFree(a);
1179: }
1180: return(0);
1181: }
1183: /*@C
1184: PetscEListFind - searches list of strings for given string, using case insensitive matching
1186: Not Collective
1188: Input Parameters:
1189: + n - number of strings in
1190: . list - list of strings to search
1191: - str - string to look for, empty string "" accepts default (first entry in list)
1193: Output Parameters:
1194: + value - index of matching string (if found)
1195: - found - boolean indicating whether string was found (can be NULL)
1197: Notes:
1198: Not for use in Fortran
1200: Level: advanced
1201: @*/
1202: PetscErrorCode PetscEListFind(PetscInt n,const char *const *list,const char *str,PetscInt *value,PetscBool *found)
1203: {
1205: PetscBool matched;
1206: PetscInt i;
1209: if (found) *found = PETSC_FALSE;
1210: for (i=0; i<n; i++) {
1211: PetscStrcasecmp(str,list[i],&matched);
1212: if (matched || !str[0]) {
1213: if (found) *found = PETSC_TRUE;
1214: *value = i;
1215: break;
1216: }
1217: }
1218: return(0);
1219: }
1221: /*@C
1222: PetscEnumFind - searches enum list of strings for given string, using case insensitive matching
1224: Not Collective
1226: Input Parameters:
1227: + enumlist - list of strings to search, followed by enum name, then enum prefix, then NUL
1228: - str - string to look for
1230: Output Parameters:
1231: + value - index of matching string (if found)
1232: - found - boolean indicating whether string was found (can be NULL)
1234: Notes:
1235: Not for use in Fortran
1237: Level: advanced
1238: @*/
1239: PetscErrorCode PetscEnumFind(const char *const *enumlist,const char *str,PetscEnum *value,PetscBool *found)
1240: {
1242: PetscInt n = 0,evalue;
1243: PetscBool efound;
1246: 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");
1247: if (n < 3) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"List argument must have at least two entries: typename and type prefix");
1248: n -= 3; /* drop enum name, prefix, and null termination */
1249: PetscEListFind(n,enumlist,str,&evalue,&efound);
1250: if (efound) *value = (PetscEnum)evalue;
1251: if (found) *found = efound;
1252: return(0);
1253: }