xref: /petsc/src/sys/utils/str.c (revision d8d34be668443a492f25d109cf196c1d22336895)
1 
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.
6 
7 */
8 #include <petscsys.h>                   /*I  "petscsys.h"   I*/
9 #if defined(PETSC_HAVE_STRING_H)
10 #include <string.h>             /* strstr */
11 #endif
12 #if defined(PETSC_HAVE_STRINGS_H)
13 #  include <strings.h>          /* strcasecmp */
14 #endif
15 
16 /*@C
17    PetscStrToArray - Separates a string by a charactor (for example ' ' or '\n') and creates an array of strings
18 
19    Not Collective
20 
21    Input Parameters:
22 +  s - pointer to string
23 -  sp - separator charactor
24 
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
28 
29    Level: intermediate
30 
31    Notes:
32     this may be called before PetscInitialize() or after PetscFinalize()
33 
34    Not for use in Fortran
35 
36    Developer Notes:
37     Using raw malloc() and does not call error handlers since this may be used before PETSc is initialized. Used
38      to generate argc, args arguments passed to MPI_Init()
39 
40 .seealso: PetscStrToArrayDestroy(), PetscToken, PetscTokenCreate()
41 
42 @*/
43 PetscErrorCode  PetscStrToArray(const char s[],char sp,int *argc,char ***args)
44 {
45   int       i,j,n,*lens,cnt = 0;
46   PetscBool flg = PETSC_FALSE;
47 
48   if (!s) n = 0;
49   else    n = strlen(s);
50   *argc = 0;
51   *args = NULL;
52   for (; n>0; n--) {   /* remove separator chars at the end - and will empty the string if all chars are separator chars */
53     if (s[n-1] != sp) break;
54   }
55   if (!n) {
56     return(0);
57   }
58   for (i=0; i<n; i++) {
59     if (s[i] != sp) break;
60   }
61   for (;i<n+1; i++) {
62     if ((s[i] == sp || s[i] == 0) && !flg) {flg = PETSC_TRUE; (*argc)++;}
63     else if (s[i] != sp) {flg = PETSC_FALSE;}
64   }
65   (*args) = (char**) malloc(((*argc)+1)*sizeof(char*)); if (!*args) return PETSC_ERR_MEM;
66   lens    = (int*) malloc((*argc)*sizeof(int)); if (!lens) return PETSC_ERR_MEM;
67   for (i=0; i<*argc; i++) lens[i] = 0;
68 
69   *argc = 0;
70   for (i=0; i<n; i++) {
71     if (s[i] != sp) break;
72   }
73   for (;i<n+1; i++) {
74     if ((s[i] == sp || s[i] == 0) && !flg) {flg = PETSC_TRUE; (*argc)++;}
75     else if (s[i] != sp) {lens[*argc]++;flg = PETSC_FALSE;}
76   }
77 
78   for (i=0; i<*argc; i++) {
79     (*args)[i] = (char*) malloc((lens[i]+1)*sizeof(char));
80     if (!(*args)[i]) {
81       free(lens);
82       for (j=0; j<i; j++) free((*args)[j]);
83       free(*args);
84       return PETSC_ERR_MEM;
85     }
86   }
87   free(lens);
88   (*args)[*argc] = 0;
89 
90   *argc = 0;
91   for (i=0; i<n; i++) {
92     if (s[i] != sp) break;
93   }
94   for (;i<n+1; i++) {
95     if ((s[i] == sp || s[i] == 0) && !flg) {flg = PETSC_TRUE; (*args)[*argc][cnt++] = 0; (*argc)++; cnt = 0;}
96     else if (s[i] != sp && s[i] != 0) {(*args)[*argc][cnt++] = s[i]; flg = PETSC_FALSE;}
97   }
98   return 0;
99 }
100 
101 /*@C
102    PetscStrToArrayDestroy - Frees array created with PetscStrToArray().
103 
104    Not Collective
105 
106    Output Parameters:
107 +  argc - the number of arguments
108 -  args - the array of arguments
109 
110    Level: intermediate
111 
112    Concepts: command line arguments
113 
114    Notes:
115     This may be called before PetscInitialize() or after PetscFinalize()
116 
117    Not for use in Fortran
118 
119 .seealso: PetscStrToArray()
120 
121 @*/
122 PetscErrorCode  PetscStrToArrayDestroy(int argc,char **args)
123 {
124   PetscInt i;
125 
126   for (i=0; i<argc; i++) free(args[i]);
127   if (args) free(args);
128   return 0;
129 }
130 
131 /*@C
132    PetscStrlen - Gets length of a string
133 
134    Not Collective
135 
136    Input Parameters:
137 .  s - pointer to string
138 
139    Output Parameter:
140 .  len - length in bytes
141 
142    Level: intermediate
143 
144    Note:
145    This routine is analogous to strlen().
146 
147    Null string returns a length of zero
148 
149    Not for use in Fortran
150 
151   Concepts: string length
152 
153 @*/
154 PetscErrorCode  PetscStrlen(const char s[],size_t *len)
155 {
156   PetscFunctionBegin;
157   if (!s) *len = 0;
158   else    *len = strlen(s);
159   PetscFunctionReturn(0);
160 }
161 
162 /*@C
163    PetscStrallocpy - Allocates space to hold a copy of a string then copies the string
164 
165    Not Collective
166 
167    Input Parameters:
168 .  s - pointer to string
169 
170    Output Parameter:
171 .  t - the copied string
172 
173    Level: intermediate
174 
175    Note:
176       Null string returns a new null string
177 
178       Not for use in Fortran
179 
180   Concepts: string copy
181 
182 @*/
183 PetscErrorCode  PetscStrallocpy(const char s[],char *t[])
184 {
185   PetscErrorCode ierr;
186   size_t         len;
187   char           *tmp = 0;
188 
189   PetscFunctionBegin;
190   if (s) {
191     ierr = PetscStrlen(s,&len);CHKERRQ(ierr);
192     ierr = PetscMalloc1(1+len,&tmp);CHKERRQ(ierr);
193     ierr = PetscStrcpy(tmp,s);CHKERRQ(ierr);
194   }
195   *t = tmp;
196   PetscFunctionReturn(0);
197 }
198 
199 /*@C
200    PetscStrArrayallocpy - Allocates space to hold a copy of an array of strings then copies the strings
201 
202    Not Collective
203 
204    Input Parameters:
205 .  s - pointer to array of strings (final string is a null)
206 
207    Output Parameter:
208 .  t - the copied array string
209 
210    Level: intermediate
211 
212    Note:
213       Not for use in Fortran
214 
215   Concepts: string copy
216 
217 .seealso: PetscStrallocpy() PetscStrArrayDestroy()
218 
219 @*/
220 PetscErrorCode  PetscStrArrayallocpy(const char *const *list,char ***t)
221 {
222   PetscErrorCode ierr;
223   PetscInt       i,n = 0;
224 
225   PetscFunctionBegin;
226   while (list[n++]) ;
227   ierr = PetscMalloc1(n+1,t);CHKERRQ(ierr);
228   for (i=0; i<n; i++) {
229     ierr = PetscStrallocpy(list[i],(*t)+i);CHKERRQ(ierr);
230   }
231   (*t)[n] = NULL;
232   PetscFunctionReturn(0);
233 }
234 
235 /*@C
236    PetscStrArrayDestroy - Frees array of strings created with PetscStrArrayallocpy().
237 
238    Not Collective
239 
240    Output Parameters:
241 .   list - array of strings
242 
243    Level: intermediate
244 
245    Concepts: command line arguments
246 
247    Notes:
248     Not for use in Fortran
249 
250 .seealso: PetscStrArrayallocpy()
251 
252 @*/
253 PetscErrorCode PetscStrArrayDestroy(char ***list)
254 {
255   PetscInt       n = 0;
256   PetscErrorCode ierr;
257 
258   PetscFunctionBegin;
259   if (!*list) PetscFunctionReturn(0);
260   while ((*list)[n]) {
261     ierr = PetscFree((*list)[n]);CHKERRQ(ierr);
262     n++;
263   }
264   ierr = PetscFree(*list);CHKERRQ(ierr);
265   PetscFunctionReturn(0);
266 }
267 
268 /*@C
269    PetscStrNArrayallocpy - Allocates space to hold a copy of an array of strings then copies the strings
270 
271    Not Collective
272 
273    Input Parameters:
274 +  n - the number of string entries
275 -  s - pointer to array of strings
276 
277    Output Parameter:
278 .  t - the copied array string
279 
280    Level: intermediate
281 
282    Note:
283       Not for use in Fortran
284 
285   Concepts: string copy
286 
287 .seealso: PetscStrallocpy() PetscStrArrayDestroy()
288 
289 @*/
290 PetscErrorCode  PetscStrNArrayallocpy(PetscInt n,const char *const *list,char ***t)
291 {
292   PetscErrorCode ierr;
293   PetscInt       i;
294 
295   PetscFunctionBegin;
296   ierr = PetscMalloc1(n,t);CHKERRQ(ierr);
297   for (i=0; i<n; i++) {
298     ierr = PetscStrallocpy(list[i],(*t)+i);CHKERRQ(ierr);
299   }
300   PetscFunctionReturn(0);
301 }
302 
303 /*@C
304    PetscStrNArrayDestroy - Frees array of strings created with PetscStrArrayallocpy().
305 
306    Not Collective
307 
308    Output Parameters:
309 +   n - number of string entries
310 -   list - array of strings
311 
312    Level: intermediate
313 
314    Notes:
315     Not for use in Fortran
316 
317 .seealso: PetscStrArrayallocpy()
318 
319 @*/
320 PetscErrorCode PetscStrNArrayDestroy(PetscInt n,char ***list)
321 {
322   PetscErrorCode ierr;
323   PetscInt       i;
324 
325   PetscFunctionBegin;
326   if (!*list) PetscFunctionReturn(0);
327   for (i=0; i<n; i++){
328     ierr = PetscFree((*list)[i]);CHKERRQ(ierr);
329   }
330   ierr = PetscFree(*list);CHKERRQ(ierr);
331   PetscFunctionReturn(0);
332 }
333 
334 /*@C
335    PetscStrcpy - Copies a string
336 
337    Not Collective
338 
339    Input Parameters:
340 .  t - pointer to string
341 
342    Output Parameter:
343 .  s - the copied string
344 
345    Level: intermediate
346 
347    Notes:
348      Null string returns a string starting with zero
349 
350      Not for use in Fortran
351 
352   Concepts: string copy
353 
354 .seealso: PetscStrncpy(), PetscStrcat(), PetscStrlcat()
355 
356 @*/
357 
358 PetscErrorCode  PetscStrcpy(char s[],const char t[])
359 {
360   PetscFunctionBegin;
361   if (t && !s) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_NULL,"Trying to copy string into null pointer");
362   if (t) strcpy(s,t);
363   else if (s) s[0] = 0;
364   PetscFunctionReturn(0);
365 }
366 
367 /*@C
368    PetscStrncpy - Copies a string up to a certain length
369 
370    Not Collective
371 
372    Input Parameters:
373 +  t - pointer to string
374 -  n - the length to copy
375 
376    Output Parameter:
377 .  s - the copied string
378 
379    Level: intermediate
380 
381    Note:
382      Null string returns a string starting with zero
383 
384      If the string that is being copied is of length n or larger then the entire string is not
385      copied and the final location of s is set to NULL. This is different then the behavior of
386      strncpy() which leaves s non-terminated if there is not room for the entire string.
387 
388   Concepts: string copy
389 
390   Developers Note: Should this be PetscStrlcpy() to reflect its behavior which is like strlcpy() not strncpy()
391 
392 .seealso: PetscStrcpy(), PetscStrcat(), PetscStrlcat()
393 
394 @*/
395 PetscErrorCode  PetscStrncpy(char s[],const char t[],size_t n)
396 {
397   PetscFunctionBegin;
398   if (t && !s) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_NULL,"Trying to copy string into null pointer");
399   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");
400   if (t) {
401     if (n > 1) {
402       strncpy(s,t,n-1);
403       s[n-1] = '\0';
404     } else {
405       s[0] = '\0';
406     }
407   } else if (s) s[0] = 0;
408   PetscFunctionReturn(0);
409 }
410 
411 /*@C
412    PetscStrcat - Concatenates a string onto a given string
413 
414    Not Collective
415 
416    Input Parameters:
417 +  s - string to be added to
418 -  t - pointer to string to be added to end
419 
420    Level: intermediate
421 
422    Notes:
423     Not for use in Fortran
424 
425   Concepts: string copy
426 
427 .seealso: PetscStrcpy(), PetscStrncpy(), PetscStrlcat()
428 
429 @*/
430 PetscErrorCode  PetscStrcat(char s[],const char t[])
431 {
432   PetscFunctionBegin;
433   if (!t) PetscFunctionReturn(0);
434   strcat(s,t);
435   PetscFunctionReturn(0);
436 }
437 
438 /*@C
439    PetscStrlcat - Concatenates a string onto a given string, up to a given length
440 
441    Not Collective
442 
443    Input Parameters:
444 +  s - pointer to string to be added to at end
445 .  t - string to be added to
446 -  n - length of the original allocated string
447 
448    Level: intermediate
449 
450   Notes:
451   Not for use in Fortran
452 
453   Unlike the system call strncat(), the length passed in is the length of the
454   original allocated space, not the length of the left-over space. This is
455   similar to the BSD system call strlcat().
456 
457   Concepts: string copy
458 
459 .seealso: PetscStrcpy(), PetscStrncpy(), PetscStrcat()
460 
461 @*/
462 PetscErrorCode  PetscStrlcat(char s[],const char t[],size_t n)
463 {
464   size_t         len;
465   PetscErrorCode ierr;
466 
467   PetscFunctionBegin;
468   if (t && !n) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ,"String buffer length must be positive");
469   if (!t) PetscFunctionReturn(0);
470   ierr = PetscStrlen(t,&len);CHKERRQ(ierr);
471   strncat(s,t,n - len);
472   s[n-1] = 0;
473   PetscFunctionReturn(0);
474 }
475 
476 void  PetscStrcmpNoError(const char a[],const char b[],PetscBool  *flg)
477 {
478   int c;
479 
480   if (!a && !b)      *flg = PETSC_TRUE;
481   else if (!a || !b) *flg = PETSC_FALSE;
482   else {
483     c = strcmp(a,b);
484     if (c) *flg = PETSC_FALSE;
485     else   *flg = PETSC_TRUE;
486   }
487 }
488 
489 /*@C
490    PetscStrcmp - Compares two strings,
491 
492    Not Collective
493 
494    Input Parameters:
495 +  a - pointer to string first string
496 -  b - pointer to second string
497 
498    Output Parameter:
499 .  flg - PETSC_TRUE if the two strings are equal
500 
501    Level: intermediate
502 
503    Notes:
504     Not for use in Fortran
505 
506 .seealso: PetscStrgrt(), PetscStrncmp(), PetscStrcasecmp()
507 
508 @*/
509 PetscErrorCode  PetscStrcmp(const char a[],const char b[],PetscBool  *flg)
510 {
511   int c;
512 
513   PetscFunctionBegin;
514   if (!a && !b)      *flg = PETSC_TRUE;
515   else if (!a || !b) *flg = PETSC_FALSE;
516   else {
517     c = strcmp(a,b);
518     if (c) *flg = PETSC_FALSE;
519     else   *flg = PETSC_TRUE;
520   }
521   PetscFunctionReturn(0);
522 }
523 
524 /*@C
525    PetscStrgrt - If first string is greater than the second
526 
527    Not Collective
528 
529    Input Parameters:
530 +  a - pointer to first string
531 -  b - pointer to second string
532 
533    Output Parameter:
534 .  flg - if the first string is greater
535 
536    Notes:
537     Null arguments are ok, a null string is considered smaller than
538     all others
539 
540    Not for use in Fortran
541 
542    Level: intermediate
543 
544 .seealso: PetscStrcmp(), PetscStrncmp(), PetscStrcasecmp()
545 
546 @*/
547 PetscErrorCode  PetscStrgrt(const char a[],const char b[],PetscBool  *t)
548 {
549   int c;
550 
551   PetscFunctionBegin;
552   if (!a && !b) *t = PETSC_FALSE;
553   else if (a && !b) *t = PETSC_TRUE;
554   else if (!a && b) *t = PETSC_FALSE;
555   else {
556     c = strcmp(a,b);
557     if (c > 0) *t = PETSC_TRUE;
558     else       *t = PETSC_FALSE;
559   }
560   PetscFunctionReturn(0);
561 }
562 
563 /*@C
564    PetscStrcasecmp - Returns true if the two strings are the same
565      except possibly for case.
566 
567    Not Collective
568 
569    Input Parameters:
570 +  a - pointer to first string
571 -  b - pointer to second string
572 
573    Output Parameter:
574 .  flg - if the two strings are the same
575 
576    Notes:
577     Null arguments are ok
578 
579    Not for use in Fortran
580 
581    Level: intermediate
582 
583 .seealso: PetscStrcmp(), PetscStrncmp(), PetscStrgrt()
584 
585 @*/
586 PetscErrorCode  PetscStrcasecmp(const char a[],const char b[],PetscBool  *t)
587 {
588   int c;
589 
590   PetscFunctionBegin;
591   if (!a && !b) c = 0;
592   else if (!a || !b) c = 1;
593 #if defined(PETSC_HAVE_STRCASECMP)
594   else c = strcasecmp(a,b);
595 #elif defined(PETSC_HAVE_STRICMP)
596   else c = stricmp(a,b);
597 #else
598   else {
599     char           *aa,*bb;
600     PetscErrorCode ierr;
601     ierr = PetscStrallocpy(a,&aa);CHKERRQ(ierr);
602     ierr = PetscStrallocpy(b,&bb);CHKERRQ(ierr);
603     ierr = PetscStrtolower(aa);CHKERRQ(ierr);
604     ierr = PetscStrtolower(bb);CHKERRQ(ierr);
605     ierr = PetscStrcmp(aa,bb,t);CHKERRQ(ierr);
606     ierr = PetscFree(aa);CHKERRQ(ierr);
607     ierr = PetscFree(bb);CHKERRQ(ierr);
608     PetscFunctionReturn(0);
609   }
610 #endif
611   if (!c) *t = PETSC_TRUE;
612   else    *t = PETSC_FALSE;
613   PetscFunctionReturn(0);
614 }
615 
616 
617 
618 /*@C
619    PetscStrncmp - Compares two strings, up to a certain length
620 
621    Not Collective
622 
623    Input Parameters:
624 +  a - pointer to first string
625 .  b - pointer to second string
626 -  n - length to compare up to
627 
628    Output Parameter:
629 .  t - if the two strings are equal
630 
631    Level: intermediate
632 
633    Notes:
634     Not for use in Fortran
635 
636 .seealso: PetscStrgrt(), PetscStrcmp(), PetscStrcasecmp()
637 
638 @*/
639 PetscErrorCode  PetscStrncmp(const char a[],const char b[],size_t n,PetscBool  *t)
640 {
641   int c;
642 
643   PetscFunctionBegin;
644   c = strncmp(a,b,n);
645   if (!c) *t = PETSC_TRUE;
646   else    *t = PETSC_FALSE;
647   PetscFunctionReturn(0);
648 }
649 
650 /*@C
651    PetscStrchr - Locates first occurance of a character in a string
652 
653    Not Collective
654 
655    Input Parameters:
656 +  a - pointer to string
657 -  b - character
658 
659    Output Parameter:
660 .  c - location of occurance, NULL if not found
661 
662    Level: intermediate
663 
664    Notes:
665     Not for use in Fortran
666 
667 @*/
668 PetscErrorCode  PetscStrchr(const char a[],char b,char *c[])
669 {
670   PetscFunctionBegin;
671   *c = (char*)strchr(a,b);
672   PetscFunctionReturn(0);
673 }
674 
675 /*@C
676    PetscStrrchr - Locates one location past the last occurance of a character in a string,
677       if the character is not found then returns entire string
678 
679    Not Collective
680 
681    Input Parameters:
682 +  a - pointer to string
683 -  b - character
684 
685    Output Parameter:
686 .  tmp - location of occurance, a if not found
687 
688    Level: intermediate
689 
690    Notes:
691     Not for use in Fortran
692 
693 @*/
694 PetscErrorCode  PetscStrrchr(const char a[],char b,char *tmp[])
695 {
696   PetscFunctionBegin;
697   *tmp = (char*)strrchr(a,b);
698   if (!*tmp) *tmp = (char*)a;
699   else *tmp = *tmp + 1;
700   PetscFunctionReturn(0);
701 }
702 
703 /*@C
704    PetscStrtolower - Converts string to lower case
705 
706    Not Collective
707 
708    Input Parameters:
709 .  a - pointer to string
710 
711    Level: intermediate
712 
713    Notes:
714     Not for use in Fortran
715 
716 @*/
717 PetscErrorCode  PetscStrtolower(char a[])
718 {
719   PetscFunctionBegin;
720   while (*a) {
721     if (*a >= 'A' && *a <= 'Z') *a += 'a' - 'A';
722     a++;
723   }
724   PetscFunctionReturn(0);
725 }
726 
727 /*@C
728    PetscStrtoupper - Converts string to upper case
729 
730    Not Collective
731 
732    Input Parameters:
733 .  a - pointer to string
734 
735    Level: intermediate
736 
737    Notes:
738     Not for use in Fortran
739 
740 @*/
741 PetscErrorCode  PetscStrtoupper(char a[])
742 {
743   PetscFunctionBegin;
744   while (*a) {
745     if (*a >= 'a' && *a <= 'z') *a += 'A' - 'a';
746     a++;
747   }
748   PetscFunctionReturn(0);
749 }
750 
751 /*@C
752    PetscStrendswith - Determines if a string ends with a certain string
753 
754    Not Collective
755 
756    Input Parameters:
757 +  a - pointer to string
758 -  b - string to endwith
759 
760    Output Parameter:
761 .  flg - PETSC_TRUE or PETSC_FALSE
762 
763    Notes:
764     Not for use in Fortran
765 
766    Level: intermediate
767 
768 @*/
769 PetscErrorCode  PetscStrendswith(const char a[],const char b[],PetscBool *flg)
770 {
771   char           *test;
772   PetscErrorCode ierr;
773   size_t         na,nb;
774 
775   PetscFunctionBegin;
776   *flg = PETSC_FALSE;
777   ierr = PetscStrrstr(a,b,&test);CHKERRQ(ierr);
778   if (test) {
779     ierr = PetscStrlen(a,&na);CHKERRQ(ierr);
780     ierr = PetscStrlen(b,&nb);CHKERRQ(ierr);
781     if (a+na-nb == test) *flg = PETSC_TRUE;
782   }
783   PetscFunctionReturn(0);
784 }
785 
786 /*@C
787    PetscStrbeginswith - Determines if a string begins with a certain string
788 
789    Not Collective
790 
791    Input Parameters:
792 +  a - pointer to string
793 -  b - string to begin with
794 
795    Output Parameter:
796 .  flg - PETSC_TRUE or PETSC_FALSE
797 
798    Notes:
799     Not for use in Fortran
800 
801    Level: intermediate
802 
803 .seealso: PetscStrendswithwhich(), PetscStrendswith(), PetscStrtoupper, PetscStrtolower(), PetscStrrchr(), PetscStrchr(),
804           PetscStrncmp(), PetscStrlen(), PetscStrncmp(), PetscStrcmp()
805 
806 @*/
807 PetscErrorCode  PetscStrbeginswith(const char a[],const char b[],PetscBool *flg)
808 {
809   char           *test;
810   PetscErrorCode ierr;
811 
812   PetscFunctionBegin;
813   *flg = PETSC_FALSE;
814   ierr = PetscStrrstr(a,b,&test);CHKERRQ(ierr);
815   if (test && (test == a)) *flg = PETSC_TRUE;
816   PetscFunctionReturn(0);
817 }
818 
819 
820 /*@C
821    PetscStrendswithwhich - Determines if a string ends with one of several possible strings
822 
823    Not Collective
824 
825    Input Parameters:
826 +  a - pointer to string
827 -  bs - strings to endwith (last entry must be null)
828 
829    Output Parameter:
830 .  cnt - the index of the string it ends with or 1+the last possible index
831 
832    Notes:
833     Not for use in Fortran
834 
835    Level: intermediate
836 
837 @*/
838 PetscErrorCode  PetscStrendswithwhich(const char a[],const char *const *bs,PetscInt *cnt)
839 {
840   PetscBool      flg;
841   PetscErrorCode ierr;
842 
843   PetscFunctionBegin;
844   *cnt = 0;
845   while (bs[*cnt]) {
846     ierr = PetscStrendswith(a,bs[*cnt],&flg);CHKERRQ(ierr);
847     if (flg) PetscFunctionReturn(0);
848     *cnt += 1;
849   }
850   PetscFunctionReturn(0);
851 }
852 
853 /*@C
854    PetscStrrstr - Locates last occurance of string in another string
855 
856    Not Collective
857 
858    Input Parameters:
859 +  a - pointer to string
860 -  b - string to find
861 
862    Output Parameter:
863 .  tmp - location of occurance
864 
865    Notes:
866     Not for use in Fortran
867 
868    Level: intermediate
869 
870 @*/
871 PetscErrorCode  PetscStrrstr(const char a[],const char b[],char *tmp[])
872 {
873   const char *stmp = a, *ltmp = 0;
874 
875   PetscFunctionBegin;
876   while (stmp) {
877     stmp = (char*)strstr(stmp,b);
878     if (stmp) {ltmp = stmp;stmp++;}
879   }
880   *tmp = (char*)ltmp;
881   PetscFunctionReturn(0);
882 }
883 
884 /*@C
885    PetscStrstr - Locates first occurance of string in another string
886 
887    Not Collective
888 
889    Input Parameters:
890 +  haystack - string to search
891 -  needle - string to find
892 
893    Output Parameter:
894 .  tmp - location of occurance, is a NULL if the string is not found
895 
896    Notes:
897     Not for use in Fortran
898 
899    Level: intermediate
900 
901 @*/
902 PetscErrorCode  PetscStrstr(const char haystack[],const char needle[],char *tmp[])
903 {
904   PetscFunctionBegin;
905   *tmp = (char*)strstr(haystack,needle);
906   PetscFunctionReturn(0);
907 }
908 
909 struct _p_PetscToken {char token;char *array;char *current;};
910 
911 /*@C
912    PetscTokenFind - Locates next "token" in a string
913 
914    Not Collective
915 
916    Input Parameters:
917 .  a - pointer to token
918 
919    Output Parameter:
920 .  result - location of occurance, NULL if not found
921 
922    Notes:
923 
924      This version is different from the system version in that
925   it allows you to pass a read-only string into the function.
926 
927      This version also treats all characters etc. inside a double quote "
928    as a single token.
929 
930      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
931    second will return a null terminated y
932 
933      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
934 
935     Not for use in Fortran
936 
937    Level: intermediate
938 
939 
940 .seealso: PetscTokenCreate(), PetscTokenDestroy()
941 @*/
942 PetscErrorCode  PetscTokenFind(PetscToken a,char *result[])
943 {
944   char *ptr = a->current,token;
945 
946   PetscFunctionBegin;
947   *result = a->current;
948   if (ptr && !*ptr) {*result = 0;PetscFunctionReturn(0);}
949   token = a->token;
950   if (ptr && (*ptr == '"')) {token = '"';(*result)++;ptr++;}
951   while (ptr) {
952     if (*ptr == token) {
953       *ptr++ = 0;
954       while (*ptr == a->token) ptr++;
955       a->current = ptr;
956       break;
957     }
958     if (!*ptr) {
959       a->current = 0;
960       break;
961     }
962     ptr++;
963   }
964   PetscFunctionReturn(0);
965 }
966 
967 /*@C
968    PetscTokenCreate - Creates a PetscToken used to find tokens in a string
969 
970    Not Collective
971 
972    Input Parameters:
973 +  string - the string to look in
974 -  b - the separator character
975 
976    Output Parameter:
977 .  t- the token object
978 
979    Notes:
980 
981      This version is different from the system version in that
982   it allows you to pass a read-only string into the function.
983 
984     Not for use in Fortran
985 
986    Level: intermediate
987 
988 .seealso: PetscTokenFind(), PetscTokenDestroy()
989 @*/
990 PetscErrorCode  PetscTokenCreate(const char a[],const char b,PetscToken *t)
991 {
992   PetscErrorCode ierr;
993 
994   PetscFunctionBegin;
995   ierr = PetscNew(t);CHKERRQ(ierr);
996   ierr = PetscStrallocpy(a,&(*t)->array);CHKERRQ(ierr);
997 
998   (*t)->current = (*t)->array;
999   (*t)->token   = b;
1000   PetscFunctionReturn(0);
1001 }
1002 
1003 /*@C
1004    PetscTokenDestroy - Destroys a PetscToken
1005 
1006    Not Collective
1007 
1008    Input Parameters:
1009 .  a - pointer to token
1010 
1011    Level: intermediate
1012 
1013    Notes:
1014     Not for use in Fortran
1015 
1016 .seealso: PetscTokenCreate(), PetscTokenFind()
1017 @*/
1018 PetscErrorCode  PetscTokenDestroy(PetscToken *a)
1019 {
1020   PetscErrorCode ierr;
1021 
1022   PetscFunctionBegin;
1023   if (!*a) PetscFunctionReturn(0);
1024   ierr = PetscFree((*a)->array);CHKERRQ(ierr);
1025   ierr = PetscFree(*a);CHKERRQ(ierr);
1026   PetscFunctionReturn(0);
1027 }
1028 
1029 /*@C
1030    PetscStrInList - search string in character-delimited list
1031 
1032    Not Collective
1033 
1034    Input Parameters:
1035 +  str - the string to look for
1036 .  list - the list to search in
1037 -  sep - the separator character
1038 
1039    Output Parameter:
1040 .  found - whether str is in list
1041 
1042    Level: intermediate
1043 
1044    Notes:
1045     Not for use in Fortran
1046 
1047 .seealso: PetscTokenCreate(), PetscTokenFind(), PetscStrcmp()
1048 @*/
1049 PetscErrorCode PetscStrInList(const char str[],const char list[],char sep,PetscBool *found)
1050 {
1051   PetscToken     token;
1052   char           *item;
1053   PetscErrorCode ierr;
1054 
1055   PetscFunctionBegin;
1056   *found = PETSC_FALSE;
1057   ierr = PetscTokenCreate(list,sep,&token);CHKERRQ(ierr);
1058   ierr = PetscTokenFind(token,&item);CHKERRQ(ierr);
1059   while (item) {
1060     ierr = PetscStrcmp(str,item,found);CHKERRQ(ierr);
1061     if (*found) break;
1062     ierr = PetscTokenFind(token,&item);CHKERRQ(ierr);
1063   }
1064   ierr = PetscTokenDestroy(&token);CHKERRQ(ierr);
1065   PetscFunctionReturn(0);
1066 }
1067 
1068 /*@C
1069    PetscGetPetscDir - Gets the directory PETSc is installed in
1070 
1071    Not Collective
1072 
1073    Output Parameter:
1074 .  dir - the directory
1075 
1076    Level: developer
1077 
1078    Notes:
1079     Not for use in Fortran
1080 
1081 @*/
1082 PetscErrorCode  PetscGetPetscDir(const char *dir[])
1083 {
1084   PetscFunctionBegin;
1085   *dir = PETSC_DIR;
1086   PetscFunctionReturn(0);
1087 }
1088 
1089 /*@C
1090    PetscStrreplace - Replaces substrings in string with other substrings
1091 
1092    Not Collective
1093 
1094    Input Parameters:
1095 +   comm - MPI_Comm of processors that are processing the string
1096 .   aa - the string to look in
1097 .   b - the resulting copy of a with replaced strings (b can be the same as a)
1098 -   len - the length of b
1099 
1100    Notes:
1101       Replaces   ${PETSC_ARCH},${PETSC_DIR},${PETSC_LIB_DIR},${DISPLAY},
1102       ${HOMEDIRECTORY},${WORKINGDIRECTORY},${USERNAME}, ${HOSTNAME} with appropriate values
1103       as well as any environmental variables.
1104 
1105       PETSC_LIB_DIR uses the environmental variable if it exists. PETSC_ARCH and PETSC_DIR use what
1106       PETSc was built with and do not use environmental variables.
1107 
1108       Not for use in Fortran
1109 
1110    Level: intermediate
1111 
1112 @*/
1113 PetscErrorCode  PetscStrreplace(MPI_Comm comm,const char aa[],char b[],size_t len)
1114 {
1115   PetscErrorCode ierr;
1116   int            i = 0;
1117   size_t         l,l1,l2,l3;
1118   char           *work,*par,*epar,env[1024],*tfree,*a = (char*)aa;
1119   const char     *s[] = {"${PETSC_ARCH}","${PETSC_DIR}","${PETSC_LIB_DIR}","${DISPLAY}","${HOMEDIRECTORY}","${WORKINGDIRECTORY}","${USERNAME}","${HOSTNAME}",0};
1120   char           *r[] = {0,0,0,0,0,0,0,0,0};
1121   PetscBool      flag;
1122 
1123   PetscFunctionBegin;
1124   if (!a || !b) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_NULL,"a and b strings must be nonnull");
1125   if (aa == b) {
1126     ierr = PetscStrallocpy(aa,(char**)&a);CHKERRQ(ierr);
1127   }
1128   ierr = PetscMalloc1(len,&work);CHKERRQ(ierr);
1129 
1130   /* get values for replaced variables */
1131   ierr = PetscStrallocpy(PETSC_ARCH,&r[0]);CHKERRQ(ierr);
1132   ierr = PetscStrallocpy(PETSC_DIR,&r[1]);CHKERRQ(ierr);
1133   ierr = PetscStrallocpy(PETSC_LIB_DIR,&r[2]);CHKERRQ(ierr);
1134   ierr = PetscMalloc1(256,&r[3]);CHKERRQ(ierr);
1135   ierr = PetscMalloc1(PETSC_MAX_PATH_LEN,&r[4]);CHKERRQ(ierr);
1136   ierr = PetscMalloc1(PETSC_MAX_PATH_LEN,&r[5]);CHKERRQ(ierr);
1137   ierr = PetscMalloc1(256,&r[6]);CHKERRQ(ierr);
1138   ierr = PetscMalloc1(256,&r[7]);CHKERRQ(ierr);
1139   ierr = PetscGetDisplay(r[3],256);CHKERRQ(ierr);
1140   ierr = PetscGetHomeDirectory(r[4],PETSC_MAX_PATH_LEN);CHKERRQ(ierr);
1141   ierr = PetscGetWorkingDirectory(r[5],PETSC_MAX_PATH_LEN);CHKERRQ(ierr);
1142   ierr = PetscGetUserName(r[6],256);CHKERRQ(ierr);
1143   ierr = PetscGetHostName(r[7],256);CHKERRQ(ierr);
1144 
1145   /* replace that are in environment */
1146   ierr = PetscOptionsGetenv(comm,"PETSC_LIB_DIR",env,1024,&flag);CHKERRQ(ierr);
1147   if (flag) {
1148     ierr = PetscFree(r[2]);CHKERRQ(ierr);
1149     ierr = PetscStrallocpy(env,&r[2]);CHKERRQ(ierr);
1150   }
1151 
1152   /* replace the requested strings */
1153   ierr = PetscStrncpy(b,a,len);CHKERRQ(ierr);
1154   while (s[i]) {
1155     ierr = PetscStrlen(s[i],&l);CHKERRQ(ierr);
1156     ierr = PetscStrstr(b,s[i],&par);CHKERRQ(ierr);
1157     while (par) {
1158       *par =  0;
1159       par += l;
1160 
1161       ierr = PetscStrlen(b,&l1);CHKERRQ(ierr);
1162       ierr = PetscStrlen(r[i],&l2);CHKERRQ(ierr);
1163       ierr = PetscStrlen(par,&l3);CHKERRQ(ierr);
1164       if (l1 + l2 + l3 >= len) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ,"b len is not long enough to hold new values");
1165       ierr = PetscStrcpy(work,b);CHKERRQ(ierr);
1166       ierr = PetscStrcat(work,r[i]);CHKERRQ(ierr);
1167       ierr = PetscStrcat(work,par);CHKERRQ(ierr);
1168       ierr = PetscStrncpy(b,work,len);CHKERRQ(ierr);
1169       ierr = PetscStrstr(b,s[i],&par);CHKERRQ(ierr);
1170     }
1171     i++;
1172   }
1173   i = 0;
1174   while (r[i]) {
1175     tfree = (char*)r[i];
1176     ierr  = PetscFree(tfree);CHKERRQ(ierr);
1177     i++;
1178   }
1179 
1180   /* look for any other ${xxx} strings to replace from environmental variables */
1181   ierr = PetscStrstr(b,"${",&par);CHKERRQ(ierr);
1182   while (par) {
1183     *par  = 0;
1184     par  += 2;
1185     ierr  = PetscStrcpy(work,b);CHKERRQ(ierr);
1186     ierr  = PetscStrstr(par,"}",&epar);CHKERRQ(ierr);
1187     *epar = 0;
1188     epar += 1;
1189     ierr  = PetscOptionsGetenv(comm,par,env,256,&flag);CHKERRQ(ierr);
1190     if (!flag) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"Substitution string ${%s} not found as environmental variable",par);
1191     ierr = PetscStrcat(work,env);CHKERRQ(ierr);
1192     ierr = PetscStrcat(work,epar);CHKERRQ(ierr);
1193     ierr = PetscStrcpy(b,work);CHKERRQ(ierr);
1194     ierr = PetscStrstr(b,"${",&par);CHKERRQ(ierr);
1195   }
1196   ierr = PetscFree(work);CHKERRQ(ierr);
1197   if (aa == b) {
1198     ierr = PetscFree(a);CHKERRQ(ierr);
1199   }
1200   PetscFunctionReturn(0);
1201 }
1202 
1203 /*@C
1204    PetscEListFind - searches list of strings for given string, using case insensitive matching
1205 
1206    Not Collective
1207 
1208    Input Parameters:
1209 +  n - number of strings in
1210 .  list - list of strings to search
1211 -  str - string to look for, empty string "" accepts default (first entry in list)
1212 
1213    Output Parameters:
1214 +  value - index of matching string (if found)
1215 -  found - boolean indicating whether string was found (can be NULL)
1216 
1217    Notes:
1218    Not for use in Fortran
1219 
1220    Level: advanced
1221 @*/
1222 PetscErrorCode PetscEListFind(PetscInt n,const char *const *list,const char *str,PetscInt *value,PetscBool *found)
1223 {
1224   PetscErrorCode ierr;
1225   PetscBool matched;
1226   PetscInt i;
1227 
1228   PetscFunctionBegin;
1229   if (found) *found = PETSC_FALSE;
1230   for (i=0; i<n; i++) {
1231     ierr = PetscStrcasecmp(str,list[i],&matched);CHKERRQ(ierr);
1232     if (matched || !str[0]) {
1233       if (found) *found = PETSC_TRUE;
1234       *value = i;
1235       break;
1236     }
1237   }
1238   PetscFunctionReturn(0);
1239 }
1240 
1241 /*@C
1242    PetscEnumFind - searches enum list of strings for given string, using case insensitive matching
1243 
1244    Not Collective
1245 
1246    Input Parameters:
1247 +  enumlist - list of strings to search, followed by enum name, then enum prefix, then NUL
1248 -  str - string to look for
1249 
1250    Output Parameters:
1251 +  value - index of matching string (if found)
1252 -  found - boolean indicating whether string was found (can be NULL)
1253 
1254    Notes:
1255    Not for use in Fortran
1256 
1257    Level: advanced
1258 @*/
1259 PetscErrorCode PetscEnumFind(const char *const *enumlist,const char *str,PetscEnum *value,PetscBool *found)
1260 {
1261   PetscErrorCode ierr;
1262   PetscInt n = 0,evalue;
1263   PetscBool efound;
1264 
1265   PetscFunctionBegin;
1266   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");
1267   if (n < 3) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"List argument must have at least two entries: typename and type prefix");
1268   n -= 3; /* drop enum name, prefix, and null termination */
1269   ierr = PetscEListFind(n,enumlist,str,&evalue,&efound);CHKERRQ(ierr);
1270   if (efound) *value = (PetscEnum)evalue;
1271   if (found) *found = efound;
1272   PetscFunctionReturn(0);
1273 }
1274