Actual source code: str.c
petsc-3.9.1 2018-04-29
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: PetscStrlen(t,&len);
460: strncat(s,t,n - len);
461: return(0);
462: }
464: /*
467: */
468: void PetscStrcmpNoError(const char a[],const char b[],PetscBool *flg)
469: {
470: int c;
472: if (!a && !b) *flg = PETSC_TRUE;
473: else if (!a || !b) *flg = PETSC_FALSE;
474: else {
475: c = strcmp(a,b);
476: if (c) *flg = PETSC_FALSE;
477: else *flg = PETSC_TRUE;
478: }
479: }
481: /*@C
482: PetscStrcmp - Compares two strings,
484: Not Collective
486: Input Parameters:
487: + a - pointer to string first string
488: - b - pointer to second string
490: Output Parameter:
491: . flg - PETSC_TRUE if the two strings are equal
493: Level: intermediate
495: Notes: Not for use in Fortran
497: .seealso: PetscStrgrt(), PetscStrncmp(), PetscStrcasecmp()
499: @*/
500: PetscErrorCode PetscStrcmp(const char a[],const char b[],PetscBool *flg)
501: {
502: int c;
505: if (!a && !b) *flg = PETSC_TRUE;
506: else if (!a || !b) *flg = PETSC_FALSE;
507: else {
508: c = strcmp(a,b);
509: if (c) *flg = PETSC_FALSE;
510: else *flg = PETSC_TRUE;
511: }
512: return(0);
513: }
515: /*@C
516: PetscStrgrt - If first string is greater than the second
518: Not Collective
520: Input Parameters:
521: + a - pointer to first string
522: - b - pointer to second string
524: Output Parameter:
525: . flg - if the first string is greater
527: Notes:
528: Null arguments are ok, a null string is considered smaller than
529: all others
531: Not for use in Fortran
533: Level: intermediate
535: .seealso: PetscStrcmp(), PetscStrncmp(), PetscStrcasecmp()
537: @*/
538: PetscErrorCode PetscStrgrt(const char a[],const char b[],PetscBool *t)
539: {
540: int c;
543: if (!a && !b) *t = PETSC_FALSE;
544: else if (a && !b) *t = PETSC_TRUE;
545: else if (!a && b) *t = PETSC_FALSE;
546: else {
547: c = strcmp(a,b);
548: if (c > 0) *t = PETSC_TRUE;
549: else *t = PETSC_FALSE;
550: }
551: return(0);
552: }
554: /*@C
555: PetscStrcasecmp - Returns true if the two strings are the same
556: except possibly for case.
558: Not Collective
560: Input Parameters:
561: + a - pointer to first string
562: - b - pointer to second string
564: Output Parameter:
565: . flg - if the two strings are the same
567: Notes:
568: Null arguments are ok
570: Not for use in Fortran
572: Level: intermediate
574: .seealso: PetscStrcmp(), PetscStrncmp(), PetscStrgrt()
576: @*/
577: PetscErrorCode PetscStrcasecmp(const char a[],const char b[],PetscBool *t)
578: {
579: int c;
582: if (!a && !b) c = 0;
583: else if (!a || !b) c = 1;
584: #if defined(PETSC_HAVE_STRCASECMP)
585: else c = strcasecmp(a,b);
586: #elif defined(PETSC_HAVE_STRICMP)
587: else c = stricmp(a,b);
588: #else
589: else {
590: char *aa,*bb;
592: PetscStrallocpy(a,&aa);
593: PetscStrallocpy(b,&bb);
594: PetscStrtolower(aa);
595: PetscStrtolower(bb);
596: PetscStrcmp(aa,bb,t);
597: PetscFree(aa);
598: PetscFree(bb);
599: return(0);
600: }
601: #endif
602: if (!c) *t = PETSC_TRUE;
603: else *t = PETSC_FALSE;
604: return(0);
605: }
609: /*@C
610: PetscStrncmp - Compares two strings, up to a certain length
612: Not Collective
614: Input Parameters:
615: + a - pointer to first string
616: . b - pointer to second string
617: - n - length to compare up to
619: Output Parameter:
620: . t - if the two strings are equal
622: Level: intermediate
624: Notes: Not for use in Fortran
626: .seealso: PetscStrgrt(), PetscStrcmp(), PetscStrcasecmp()
628: @*/
629: PetscErrorCode PetscStrncmp(const char a[],const char b[],size_t n,PetscBool *t)
630: {
631: int c;
634: c = strncmp(a,b,n);
635: if (!c) *t = PETSC_TRUE;
636: else *t = PETSC_FALSE;
637: return(0);
638: }
640: /*@C
641: PetscStrchr - Locates first occurance of a character in a string
643: Not Collective
645: Input Parameters:
646: + a - pointer to string
647: - b - character
649: Output Parameter:
650: . c - location of occurance, NULL if not found
652: Level: intermediate
654: Notes: Not for use in Fortran
656: @*/
657: PetscErrorCode PetscStrchr(const char a[],char b,char *c[])
658: {
660: *c = (char*)strchr(a,b);
661: return(0);
662: }
664: /*@C
665: PetscStrrchr - Locates one location past the last occurance of a character in a string,
666: if the character is not found then returns entire string
668: Not Collective
670: Input Parameters:
671: + a - pointer to string
672: - b - character
674: Output Parameter:
675: . tmp - location of occurance, a if not found
677: Level: intermediate
679: Notes: Not for use in Fortran
681: @*/
682: PetscErrorCode PetscStrrchr(const char a[],char b,char *tmp[])
683: {
685: *tmp = (char*)strrchr(a,b);
686: if (!*tmp) *tmp = (char*)a;
687: else *tmp = *tmp + 1;
688: return(0);
689: }
691: /*@C
692: PetscStrtolower - Converts string to lower case
694: Not Collective
696: Input Parameters:
697: . a - pointer to string
699: Level: intermediate
701: Notes: Not for use in Fortran
703: @*/
704: PetscErrorCode PetscStrtolower(char a[])
705: {
707: while (*a) {
708: if (*a >= 'A' && *a <= 'Z') *a += 'a' - 'A';
709: a++;
710: }
711: return(0);
712: }
714: /*@C
715: PetscStrtoupper - Converts string to upper case
717: Not Collective
719: Input Parameters:
720: . a - pointer to string
722: Level: intermediate
724: Notes: Not for use in Fortran
726: @*/
727: PetscErrorCode PetscStrtoupper(char a[])
728: {
730: while (*a) {
731: if (*a >= 'a' && *a <= 'z') *a += 'A' - 'a';
732: a++;
733: }
734: return(0);
735: }
737: /*@C
738: PetscStrendswith - Determines if a string ends with a certain string
740: Not Collective
742: Input Parameters:
743: + a - pointer to string
744: - b - string to endwith
746: Output Parameter:
747: . flg - PETSC_TRUE or PETSC_FALSE
749: Notes: Not for use in Fortran
751: Level: intermediate
753: @*/
754: PetscErrorCode PetscStrendswith(const char a[],const char b[],PetscBool *flg)
755: {
756: char *test;
758: size_t na,nb;
761: *flg = PETSC_FALSE;
762: PetscStrrstr(a,b,&test);
763: if (test) {
764: PetscStrlen(a,&na);
765: PetscStrlen(b,&nb);
766: if (a+na-nb == test) *flg = PETSC_TRUE;
767: }
768: return(0);
769: }
771: /*@C
772: PetscStrbeginswith - Determines if a string begins with a certain string
774: Not Collective
776: Input Parameters:
777: + a - pointer to string
778: - b - string to begin with
780: Output Parameter:
781: . flg - PETSC_TRUE or PETSC_FALSE
783: Notes: Not for use in Fortran
785: Level: intermediate
787: .seealso: PetscStrendswithwhich(), PetscStrendswith(), PetscStrtoupper, PetscStrtolower(), PetscStrrchr(), PetscStrchr(),
788: PetscStrncmp(), PetscStrlen(), PetscStrncmp(), PetscStrcmp()
790: @*/
791: PetscErrorCode PetscStrbeginswith(const char a[],const char b[],PetscBool *flg)
792: {
793: char *test;
797: *flg = PETSC_FALSE;
798: PetscStrrstr(a,b,&test);
799: if (test && (test == a)) *flg = PETSC_TRUE;
800: return(0);
801: }
804: /*@C
805: PetscStrendswithwhich - Determines if a string ends with one of several possible strings
807: Not Collective
809: Input Parameters:
810: + a - pointer to string
811: - bs - strings to endwith (last entry must be null)
813: Output Parameter:
814: . cnt - the index of the string it ends with or 1+the last possible index
816: Notes: Not for use in Fortran
818: Level: intermediate
820: @*/
821: PetscErrorCode PetscStrendswithwhich(const char a[],const char *const *bs,PetscInt *cnt)
822: {
823: PetscBool flg;
827: *cnt = 0;
828: while (bs[*cnt]) {
829: PetscStrendswith(a,bs[*cnt],&flg);
830: if (flg) return(0);
831: *cnt += 1;
832: }
833: return(0);
834: }
836: /*@C
837: PetscStrrstr - Locates last occurance of string in another string
839: Not Collective
841: Input Parameters:
842: + a - pointer to string
843: - b - string to find
845: Output Parameter:
846: . tmp - location of occurance
848: Notes: Not for use in Fortran
850: Level: intermediate
852: @*/
853: PetscErrorCode PetscStrrstr(const char a[],const char b[],char *tmp[])
854: {
855: const char *stmp = a, *ltmp = 0;
858: while (stmp) {
859: stmp = (char*)strstr(stmp,b);
860: if (stmp) {ltmp = stmp;stmp++;}
861: }
862: *tmp = (char*)ltmp;
863: return(0);
864: }
866: /*@C
867: PetscStrstr - Locates first occurance of string in another string
869: Not Collective
871: Input Parameters:
872: + haystack - string to search
873: - needle - string to find
875: Output Parameter:
876: . tmp - location of occurance, is a NULL if the string is not found
878: Notes: Not for use in Fortran
880: Level: intermediate
882: @*/
883: PetscErrorCode PetscStrstr(const char haystack[],const char needle[],char *tmp[])
884: {
886: *tmp = (char*)strstr(haystack,needle);
887: return(0);
888: }
890: struct _p_PetscToken {char token;char *array;char *current;};
892: /*@C
893: PetscTokenFind - Locates next "token" in a string
895: Not Collective
897: Input Parameters:
898: . a - pointer to token
900: Output Parameter:
901: . result - location of occurance, NULL if not found
903: Notes:
905: This version is different from the system version in that
906: it allows you to pass a read-only string into the function.
908: This version also treats all characters etc. inside a double quote "
909: as a single token.
911: 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
912: second will return a null terminated y
914: 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
916: Not for use in Fortran
918: Level: intermediate
921: .seealso: PetscTokenCreate(), PetscTokenDestroy()
922: @*/
923: PetscErrorCode PetscTokenFind(PetscToken a,char *result[])
924: {
925: char *ptr = a->current,token;
928: *result = a->current;
929: if (ptr && !*ptr) {*result = 0;return(0);}
930: token = a->token;
931: if (ptr && (*ptr == '"')) {token = '"';(*result)++;ptr++;}
932: while (ptr) {
933: if (*ptr == token) {
934: *ptr++ = 0;
935: while (*ptr == a->token) ptr++;
936: a->current = ptr;
937: break;
938: }
939: if (!*ptr) {
940: a->current = 0;
941: break;
942: }
943: ptr++;
944: }
945: return(0);
946: }
948: /*@C
949: PetscTokenCreate - Creates a PetscToken used to find tokens in a string
951: Not Collective
953: Input Parameters:
954: + string - the string to look in
955: - b - the separator character
957: Output Parameter:
958: . t- the token object
960: Notes:
962: This version is different from the system version in that
963: it allows you to pass a read-only string into the function.
965: Not for use in Fortran
967: Level: intermediate
969: .seealso: PetscTokenFind(), PetscTokenDestroy()
970: @*/
971: PetscErrorCode PetscTokenCreate(const char a[],const char b,PetscToken *t)
972: {
976: PetscNew(t);
977: PetscStrallocpy(a,&(*t)->array);
979: (*t)->current = (*t)->array;
980: (*t)->token = b;
981: return(0);
982: }
984: /*@C
985: PetscTokenDestroy - Destroys a PetscToken
987: Not Collective
989: Input Parameters:
990: . a - pointer to token
992: Level: intermediate
994: Notes: Not for use in Fortran
996: .seealso: PetscTokenCreate(), PetscTokenFind()
997: @*/
998: PetscErrorCode PetscTokenDestroy(PetscToken *a)
999: {
1003: if (!*a) return(0);
1004: PetscFree((*a)->array);
1005: PetscFree(*a);
1006: return(0);
1007: }
1009: /*@C
1010: PetscStrInList - search string in character-delimited list
1012: Not Collective
1014: Input Parameters:
1015: + str - the string to look for
1016: . list - the list to search in
1017: - sep - the separator character
1019: Output Parameter:
1020: . found - whether str is in list
1022: Level: intermediate
1024: Notes: Not for use in Fortran
1026: .seealso: PetscTokenCreate(), PetscTokenFind(), PetscStrcmp()
1027: @*/
1028: PetscErrorCode PetscStrInList(const char str[],const char list[],char sep,PetscBool *found)
1029: {
1030: PetscToken token;
1031: char *item;
1035: *found = PETSC_FALSE;
1036: PetscTokenCreate(list,sep,&token);
1037: PetscTokenFind(token,&item);
1038: while (item) {
1039: PetscStrcmp(str,item,found);
1040: if (*found) break;
1041: PetscTokenFind(token,&item);
1042: }
1043: PetscTokenDestroy(&token);
1044: return(0);
1045: }
1047: /*@C
1048: PetscGetPetscDir - Gets the directory PETSc is installed in
1050: Not Collective
1052: Output Parameter:
1053: . dir - the directory
1055: Level: developer
1057: Notes: Not for use in Fortran
1059: @*/
1060: PetscErrorCode PetscGetPetscDir(const char *dir[])
1061: {
1063: *dir = PETSC_DIR;
1064: return(0);
1065: }
1067: /*@C
1068: PetscStrreplace - Replaces substrings in string with other substrings
1070: Not Collective
1072: Input Parameters:
1073: + comm - MPI_Comm of processors that are processing the string
1074: . aa - the string to look in
1075: . b - the resulting copy of a with replaced strings (b can be the same as a)
1076: - len - the length of b
1078: Notes:
1079: Replaces ${PETSC_ARCH},${PETSC_DIR},${PETSC_LIB_DIR},${DISPLAY},
1080: ${HOMEDIRECTORY},${WORKINGDIRECTORY},${USERNAME}, ${HOSTNAME} with appropriate values
1081: as well as any environmental variables.
1083: PETSC_LIB_DIR uses the environmental variable if it exists. PETSC_ARCH and PETSC_DIR use what
1084: PETSc was built with and do not use environmental variables.
1086: Not for use in Fortran
1088: Level: intermediate
1090: @*/
1091: PetscErrorCode PetscStrreplace(MPI_Comm comm,const char aa[],char b[],size_t len)
1092: {
1094: int i = 0;
1095: size_t l,l1,l2,l3;
1096: char *work,*par,*epar,env[1024],*tfree,*a = (char*)aa;
1097: const char *s[] = {"${PETSC_ARCH}","${PETSC_DIR}","${PETSC_LIB_DIR}","${DISPLAY}","${HOMEDIRECTORY}","${WORKINGDIRECTORY}","${USERNAME}","${HOSTNAME}",0};
1098: char *r[] = {0,0,0,0,0,0,0,0,0};
1099: PetscBool flag;
1102: if (!a || !b) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_NULL,"a and b strings must be nonnull");
1103: if (aa == b) {
1104: PetscStrallocpy(aa,(char**)&a);
1105: }
1106: PetscMalloc1(len,&work);
1108: /* get values for replaced variables */
1109: PetscStrallocpy(PETSC_ARCH,&r[0]);
1110: PetscStrallocpy(PETSC_DIR,&r[1]);
1111: PetscStrallocpy(PETSC_LIB_DIR,&r[2]);
1112: PetscMalloc1(256,&r[3]);
1113: PetscMalloc1(PETSC_MAX_PATH_LEN,&r[4]);
1114: PetscMalloc1(PETSC_MAX_PATH_LEN,&r[5]);
1115: PetscMalloc1(256,&r[6]);
1116: PetscMalloc1(256,&r[7]);
1117: PetscGetDisplay(r[3],256);
1118: PetscGetHomeDirectory(r[4],PETSC_MAX_PATH_LEN);
1119: PetscGetWorkingDirectory(r[5],PETSC_MAX_PATH_LEN);
1120: PetscGetUserName(r[6],256);
1121: PetscGetHostName(r[7],256);
1123: /* replace that are in environment */
1124: PetscOptionsGetenv(comm,"PETSC_LIB_DIR",env,1024,&flag);
1125: if (flag) {
1126: PetscFree(r[2]);
1127: PetscStrallocpy(env,&r[2]);
1128: }
1130: /* replace the requested strings */
1131: PetscStrncpy(b,a,len);
1132: while (s[i]) {
1133: PetscStrlen(s[i],&l);
1134: PetscStrstr(b,s[i],&par);
1135: while (par) {
1136: *par = 0;
1137: par += l;
1139: PetscStrlen(b,&l1);
1140: PetscStrlen(r[i],&l2);
1141: PetscStrlen(par,&l3);
1142: if (l1 + l2 + l3 >= len) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ,"b len is not long enough to hold new values");
1143: PetscStrcpy(work,b);
1144: PetscStrcat(work,r[i]);
1145: PetscStrcat(work,par);
1146: PetscStrncpy(b,work,len);
1147: PetscStrstr(b,s[i],&par);
1148: }
1149: i++;
1150: }
1151: i = 0;
1152: while (r[i]) {
1153: tfree = (char*)r[i];
1154: PetscFree(tfree);
1155: i++;
1156: }
1158: /* look for any other ${xxx} strings to replace from environmental variables */
1159: PetscStrstr(b,"${",&par);
1160: while (par) {
1161: *par = 0;
1162: par += 2;
1163: PetscStrcpy(work,b);
1164: PetscStrstr(par,"}",&epar);
1165: *epar = 0;
1166: epar += 1;
1167: PetscOptionsGetenv(comm,par,env,256,&flag);
1168: if (!flag) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"Substitution string ${%s} not found as environmental variable",par);
1169: PetscStrcat(work,env);
1170: PetscStrcat(work,epar);
1171: PetscStrcpy(b,work);
1172: PetscStrstr(b,"${",&par);
1173: }
1174: PetscFree(work);
1175: if (aa == b) {
1176: PetscFree(a);
1177: }
1178: return(0);
1179: }
1181: /*@C
1182: PetscEListFind - searches list of strings for given string, using case insensitive matching
1184: Not Collective
1186: Input Parameters:
1187: + n - number of strings in
1188: . list - list of strings to search
1189: - str - string to look for, empty string "" accepts default (first entry in list)
1191: Output Parameters:
1192: + value - index of matching string (if found)
1193: - found - boolean indicating whether string was found (can be NULL)
1195: Notes:
1196: Not for use in Fortran
1198: Level: advanced
1199: @*/
1200: PetscErrorCode PetscEListFind(PetscInt n,const char *const *list,const char *str,PetscInt *value,PetscBool *found)
1201: {
1203: PetscBool matched;
1204: PetscInt i;
1207: if (found) *found = PETSC_FALSE;
1208: for (i=0; i<n; i++) {
1209: PetscStrcasecmp(str,list[i],&matched);
1210: if (matched || !str[0]) {
1211: if (found) *found = PETSC_TRUE;
1212: *value = i;
1213: break;
1214: }
1215: }
1216: return(0);
1217: }
1219: /*@C
1220: PetscEnumFind - searches enum list of strings for given string, using case insensitive matching
1222: Not Collective
1224: Input Parameters:
1225: + enumlist - list of strings to search, followed by enum name, then enum prefix, then NUL
1226: - str - string to look for
1228: Output Parameters:
1229: + value - index of matching string (if found)
1230: - found - boolean indicating whether string was found (can be NULL)
1232: Notes:
1233: Not for use in Fortran
1235: Level: advanced
1236: @*/
1237: PetscErrorCode PetscEnumFind(const char *const *enumlist,const char *str,PetscEnum *value,PetscBool *found)
1238: {
1240: PetscInt n = 0,evalue;
1241: PetscBool efound;
1244: 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");
1245: if (n < 3) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"List argument must have at least two entries: typename and type prefix");
1246: n -= 3; /* drop enum name, prefix, and null termination */
1247: PetscEListFind(n,enumlist,str,&evalue,&efound);
1248: if (efound) *value = (PetscEnum)evalue;
1249: if (found) *found = efound;
1250: return(0);
1251: }