xref: /petsc/src/sys/utils/str.c (revision 285fb4e2b69b3de46a0633bd0adc6a7f684caa1e)
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 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   ierr = PetscStrlen(t,&len);CHKERRQ(ierr);
470   strncat(s,t,n - len);
471   s[n-1] = 0;
472   PetscFunctionReturn(0);
473 }
474 
475 /*
476    Only to be used with PetscCheck__FUNCT__()!
477 
478 */
479 void  PetscStrcmpNoError(const char a[],const char b[],PetscBool  *flg)
480 {
481   int c;
482 
483   if (!a && !b)      *flg = PETSC_TRUE;
484   else if (!a || !b) *flg = PETSC_FALSE;
485   else {
486     c = strcmp(a,b);
487     if (c) *flg = PETSC_FALSE;
488     else   *flg = PETSC_TRUE;
489   }
490 }
491 
492 /*@C
493    PetscStrcmp - Compares two strings,
494 
495    Not Collective
496 
497    Input Parameters:
498 +  a - pointer to string first string
499 -  b - pointer to second string
500 
501    Output Parameter:
502 .  flg - PETSC_TRUE if the two strings are equal
503 
504    Level: intermediate
505 
506    Notes:
507     Not for use in Fortran
508 
509 .seealso: PetscStrgrt(), PetscStrncmp(), PetscStrcasecmp()
510 
511 @*/
512 PetscErrorCode  PetscStrcmp(const char a[],const char b[],PetscBool  *flg)
513 {
514   int c;
515 
516   PetscFunctionBegin;
517   if (!a && !b)      *flg = PETSC_TRUE;
518   else if (!a || !b) *flg = PETSC_FALSE;
519   else {
520     c = strcmp(a,b);
521     if (c) *flg = PETSC_FALSE;
522     else   *flg = PETSC_TRUE;
523   }
524   PetscFunctionReturn(0);
525 }
526 
527 /*@C
528    PetscStrgrt - If first string is greater than the second
529 
530    Not Collective
531 
532    Input Parameters:
533 +  a - pointer to first string
534 -  b - pointer to second string
535 
536    Output Parameter:
537 .  flg - if the first string is greater
538 
539    Notes:
540     Null arguments are ok, a null string is considered smaller than
541     all others
542 
543    Not for use in Fortran
544 
545    Level: intermediate
546 
547 .seealso: PetscStrcmp(), PetscStrncmp(), PetscStrcasecmp()
548 
549 @*/
550 PetscErrorCode  PetscStrgrt(const char a[],const char b[],PetscBool  *t)
551 {
552   int c;
553 
554   PetscFunctionBegin;
555   if (!a && !b) *t = PETSC_FALSE;
556   else if (a && !b) *t = PETSC_TRUE;
557   else if (!a && b) *t = PETSC_FALSE;
558   else {
559     c = strcmp(a,b);
560     if (c > 0) *t = PETSC_TRUE;
561     else       *t = PETSC_FALSE;
562   }
563   PetscFunctionReturn(0);
564 }
565 
566 /*@C
567    PetscStrcasecmp - Returns true if the two strings are the same
568      except possibly for case.
569 
570    Not Collective
571 
572    Input Parameters:
573 +  a - pointer to first string
574 -  b - pointer to second string
575 
576    Output Parameter:
577 .  flg - if the two strings are the same
578 
579    Notes:
580     Null arguments are ok
581 
582    Not for use in Fortran
583 
584    Level: intermediate
585 
586 .seealso: PetscStrcmp(), PetscStrncmp(), PetscStrgrt()
587 
588 @*/
589 PetscErrorCode  PetscStrcasecmp(const char a[],const char b[],PetscBool  *t)
590 {
591   int c;
592 
593   PetscFunctionBegin;
594   if (!a && !b) c = 0;
595   else if (!a || !b) c = 1;
596 #if defined(PETSC_HAVE_STRCASECMP)
597   else c = strcasecmp(a,b);
598 #elif defined(PETSC_HAVE_STRICMP)
599   else c = stricmp(a,b);
600 #else
601   else {
602     char           *aa,*bb;
603     PetscErrorCode ierr;
604     ierr = PetscStrallocpy(a,&aa);CHKERRQ(ierr);
605     ierr = PetscStrallocpy(b,&bb);CHKERRQ(ierr);
606     ierr = PetscStrtolower(aa);CHKERRQ(ierr);
607     ierr = PetscStrtolower(bb);CHKERRQ(ierr);
608     ierr = PetscStrcmp(aa,bb,t);CHKERRQ(ierr);
609     ierr = PetscFree(aa);CHKERRQ(ierr);
610     ierr = PetscFree(bb);CHKERRQ(ierr);
611     PetscFunctionReturn(0);
612   }
613 #endif
614   if (!c) *t = PETSC_TRUE;
615   else    *t = PETSC_FALSE;
616   PetscFunctionReturn(0);
617 }
618 
619 
620 
621 /*@C
622    PetscStrncmp - Compares two strings, up to a certain length
623 
624    Not Collective
625 
626    Input Parameters:
627 +  a - pointer to first string
628 .  b - pointer to second string
629 -  n - length to compare up to
630 
631    Output Parameter:
632 .  t - if the two strings are equal
633 
634    Level: intermediate
635 
636    Notes:
637     Not for use in Fortran
638 
639 .seealso: PetscStrgrt(), PetscStrcmp(), PetscStrcasecmp()
640 
641 @*/
642 PetscErrorCode  PetscStrncmp(const char a[],const char b[],size_t n,PetscBool  *t)
643 {
644   int c;
645 
646   PetscFunctionBegin;
647   c = strncmp(a,b,n);
648   if (!c) *t = PETSC_TRUE;
649   else    *t = PETSC_FALSE;
650   PetscFunctionReturn(0);
651 }
652 
653 /*@C
654    PetscStrchr - Locates first occurance of a character in a string
655 
656    Not Collective
657 
658    Input Parameters:
659 +  a - pointer to string
660 -  b - character
661 
662    Output Parameter:
663 .  c - location of occurance, NULL if not found
664 
665    Level: intermediate
666 
667    Notes:
668     Not for use in Fortran
669 
670 @*/
671 PetscErrorCode  PetscStrchr(const char a[],char b,char *c[])
672 {
673   PetscFunctionBegin;
674   *c = (char*)strchr(a,b);
675   PetscFunctionReturn(0);
676 }
677 
678 /*@C
679    PetscStrrchr - Locates one location past the last occurance of a character in a string,
680       if the character is not found then returns entire string
681 
682    Not Collective
683 
684    Input Parameters:
685 +  a - pointer to string
686 -  b - character
687 
688    Output Parameter:
689 .  tmp - location of occurance, a if not found
690 
691    Level: intermediate
692 
693    Notes:
694     Not for use in Fortran
695 
696 @*/
697 PetscErrorCode  PetscStrrchr(const char a[],char b,char *tmp[])
698 {
699   PetscFunctionBegin;
700   *tmp = (char*)strrchr(a,b);
701   if (!*tmp) *tmp = (char*)a;
702   else *tmp = *tmp + 1;
703   PetscFunctionReturn(0);
704 }
705 
706 /*@C
707    PetscStrtolower - Converts string to lower case
708 
709    Not Collective
710 
711    Input Parameters:
712 .  a - pointer to string
713 
714    Level: intermediate
715 
716    Notes:
717     Not for use in Fortran
718 
719 @*/
720 PetscErrorCode  PetscStrtolower(char a[])
721 {
722   PetscFunctionBegin;
723   while (*a) {
724     if (*a >= 'A' && *a <= 'Z') *a += 'a' - 'A';
725     a++;
726   }
727   PetscFunctionReturn(0);
728 }
729 
730 /*@C
731    PetscStrtoupper - Converts string to upper case
732 
733    Not Collective
734 
735    Input Parameters:
736 .  a - pointer to string
737 
738    Level: intermediate
739 
740    Notes:
741     Not for use in Fortran
742 
743 @*/
744 PetscErrorCode  PetscStrtoupper(char a[])
745 {
746   PetscFunctionBegin;
747   while (*a) {
748     if (*a >= 'a' && *a <= 'z') *a += 'A' - 'a';
749     a++;
750   }
751   PetscFunctionReturn(0);
752 }
753 
754 /*@C
755    PetscStrendswith - Determines if a string ends with a certain string
756 
757    Not Collective
758 
759    Input Parameters:
760 +  a - pointer to string
761 -  b - string to endwith
762 
763    Output Parameter:
764 .  flg - PETSC_TRUE or PETSC_FALSE
765 
766    Notes:
767     Not for use in Fortran
768 
769    Level: intermediate
770 
771 @*/
772 PetscErrorCode  PetscStrendswith(const char a[],const char b[],PetscBool *flg)
773 {
774   char           *test;
775   PetscErrorCode ierr;
776   size_t         na,nb;
777 
778   PetscFunctionBegin;
779   *flg = PETSC_FALSE;
780   ierr = PetscStrrstr(a,b,&test);CHKERRQ(ierr);
781   if (test) {
782     ierr = PetscStrlen(a,&na);CHKERRQ(ierr);
783     ierr = PetscStrlen(b,&nb);CHKERRQ(ierr);
784     if (a+na-nb == test) *flg = PETSC_TRUE;
785   }
786   PetscFunctionReturn(0);
787 }
788 
789 /*@C
790    PetscStrbeginswith - Determines if a string begins with a certain string
791 
792    Not Collective
793 
794    Input Parameters:
795 +  a - pointer to string
796 -  b - string to begin with
797 
798    Output Parameter:
799 .  flg - PETSC_TRUE or PETSC_FALSE
800 
801    Notes:
802     Not for use in Fortran
803 
804    Level: intermediate
805 
806 .seealso: PetscStrendswithwhich(), PetscStrendswith(), PetscStrtoupper, PetscStrtolower(), PetscStrrchr(), PetscStrchr(),
807           PetscStrncmp(), PetscStrlen(), PetscStrncmp(), PetscStrcmp()
808 
809 @*/
810 PetscErrorCode  PetscStrbeginswith(const char a[],const char b[],PetscBool *flg)
811 {
812   char           *test;
813   PetscErrorCode ierr;
814 
815   PetscFunctionBegin;
816   *flg = PETSC_FALSE;
817   ierr = PetscStrrstr(a,b,&test);CHKERRQ(ierr);
818   if (test && (test == a)) *flg = PETSC_TRUE;
819   PetscFunctionReturn(0);
820 }
821 
822 
823 /*@C
824    PetscStrendswithwhich - Determines if a string ends with one of several possible strings
825 
826    Not Collective
827 
828    Input Parameters:
829 +  a - pointer to string
830 -  bs - strings to endwith (last entry must be null)
831 
832    Output Parameter:
833 .  cnt - the index of the string it ends with or 1+the last possible index
834 
835    Notes:
836     Not for use in Fortran
837 
838    Level: intermediate
839 
840 @*/
841 PetscErrorCode  PetscStrendswithwhich(const char a[],const char *const *bs,PetscInt *cnt)
842 {
843   PetscBool      flg;
844   PetscErrorCode ierr;
845 
846   PetscFunctionBegin;
847   *cnt = 0;
848   while (bs[*cnt]) {
849     ierr = PetscStrendswith(a,bs[*cnt],&flg);CHKERRQ(ierr);
850     if (flg) PetscFunctionReturn(0);
851     *cnt += 1;
852   }
853   PetscFunctionReturn(0);
854 }
855 
856 /*@C
857    PetscStrrstr - Locates last occurance of string in another string
858 
859    Not Collective
860 
861    Input Parameters:
862 +  a - pointer to string
863 -  b - string to find
864 
865    Output Parameter:
866 .  tmp - location of occurance
867 
868    Notes:
869     Not for use in Fortran
870 
871    Level: intermediate
872 
873 @*/
874 PetscErrorCode  PetscStrrstr(const char a[],const char b[],char *tmp[])
875 {
876   const char *stmp = a, *ltmp = 0;
877 
878   PetscFunctionBegin;
879   while (stmp) {
880     stmp = (char*)strstr(stmp,b);
881     if (stmp) {ltmp = stmp;stmp++;}
882   }
883   *tmp = (char*)ltmp;
884   PetscFunctionReturn(0);
885 }
886 
887 /*@C
888    PetscStrstr - Locates first occurance of string in another string
889 
890    Not Collective
891 
892    Input Parameters:
893 +  haystack - string to search
894 -  needle - string to find
895 
896    Output Parameter:
897 .  tmp - location of occurance, is a NULL if the string is not found
898 
899    Notes:
900     Not for use in Fortran
901 
902    Level: intermediate
903 
904 @*/
905 PetscErrorCode  PetscStrstr(const char haystack[],const char needle[],char *tmp[])
906 {
907   PetscFunctionBegin;
908   *tmp = (char*)strstr(haystack,needle);
909   PetscFunctionReturn(0);
910 }
911 
912 struct _p_PetscToken {char token;char *array;char *current;};
913 
914 /*@C
915    PetscTokenFind - Locates next "token" in a string
916 
917    Not Collective
918 
919    Input Parameters:
920 .  a - pointer to token
921 
922    Output Parameter:
923 .  result - location of occurance, NULL if not found
924 
925    Notes:
926 
927      This version is different from the system version in that
928   it allows you to pass a read-only string into the function.
929 
930      This version also treats all characters etc. inside a double quote "
931    as a single token.
932 
933      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
934    second will return a null terminated y
935 
936      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
937 
938     Not for use in Fortran
939 
940    Level: intermediate
941 
942 
943 .seealso: PetscTokenCreate(), PetscTokenDestroy()
944 @*/
945 PetscErrorCode  PetscTokenFind(PetscToken a,char *result[])
946 {
947   char *ptr = a->current,token;
948 
949   PetscFunctionBegin;
950   *result = a->current;
951   if (ptr && !*ptr) {*result = 0;PetscFunctionReturn(0);}
952   token = a->token;
953   if (ptr && (*ptr == '"')) {token = '"';(*result)++;ptr++;}
954   while (ptr) {
955     if (*ptr == token) {
956       *ptr++ = 0;
957       while (*ptr == a->token) ptr++;
958       a->current = ptr;
959       break;
960     }
961     if (!*ptr) {
962       a->current = 0;
963       break;
964     }
965     ptr++;
966   }
967   PetscFunctionReturn(0);
968 }
969 
970 /*@C
971    PetscTokenCreate - Creates a PetscToken used to find tokens in a string
972 
973    Not Collective
974 
975    Input Parameters:
976 +  string - the string to look in
977 -  b - the separator character
978 
979    Output Parameter:
980 .  t- the token object
981 
982    Notes:
983 
984      This version is different from the system version in that
985   it allows you to pass a read-only string into the function.
986 
987     Not for use in Fortran
988 
989    Level: intermediate
990 
991 .seealso: PetscTokenFind(), PetscTokenDestroy()
992 @*/
993 PetscErrorCode  PetscTokenCreate(const char a[],const char b,PetscToken *t)
994 {
995   PetscErrorCode ierr;
996 
997   PetscFunctionBegin;
998   ierr = PetscNew(t);CHKERRQ(ierr);
999   ierr = PetscStrallocpy(a,&(*t)->array);CHKERRQ(ierr);
1000 
1001   (*t)->current = (*t)->array;
1002   (*t)->token   = b;
1003   PetscFunctionReturn(0);
1004 }
1005 
1006 /*@C
1007    PetscTokenDestroy - Destroys a PetscToken
1008 
1009    Not Collective
1010 
1011    Input Parameters:
1012 .  a - pointer to token
1013 
1014    Level: intermediate
1015 
1016    Notes:
1017     Not for use in Fortran
1018 
1019 .seealso: PetscTokenCreate(), PetscTokenFind()
1020 @*/
1021 PetscErrorCode  PetscTokenDestroy(PetscToken *a)
1022 {
1023   PetscErrorCode ierr;
1024 
1025   PetscFunctionBegin;
1026   if (!*a) PetscFunctionReturn(0);
1027   ierr = PetscFree((*a)->array);CHKERRQ(ierr);
1028   ierr = PetscFree(*a);CHKERRQ(ierr);
1029   PetscFunctionReturn(0);
1030 }
1031 
1032 /*@C
1033    PetscStrInList - search string in character-delimited list
1034 
1035    Not Collective
1036 
1037    Input Parameters:
1038 +  str - the string to look for
1039 .  list - the list to search in
1040 -  sep - the separator character
1041 
1042    Output Parameter:
1043 .  found - whether str is in list
1044 
1045    Level: intermediate
1046 
1047    Notes:
1048     Not for use in Fortran
1049 
1050 .seealso: PetscTokenCreate(), PetscTokenFind(), PetscStrcmp()
1051 @*/
1052 PetscErrorCode PetscStrInList(const char str[],const char list[],char sep,PetscBool *found)
1053 {
1054   PetscToken     token;
1055   char           *item;
1056   PetscErrorCode ierr;
1057 
1058   PetscFunctionBegin;
1059   *found = PETSC_FALSE;
1060   ierr = PetscTokenCreate(list,sep,&token);CHKERRQ(ierr);
1061   ierr = PetscTokenFind(token,&item);CHKERRQ(ierr);
1062   while (item) {
1063     ierr = PetscStrcmp(str,item,found);CHKERRQ(ierr);
1064     if (*found) break;
1065     ierr = PetscTokenFind(token,&item);CHKERRQ(ierr);
1066   }
1067   ierr = PetscTokenDestroy(&token);CHKERRQ(ierr);
1068   PetscFunctionReturn(0);
1069 }
1070 
1071 /*@C
1072    PetscGetPetscDir - Gets the directory PETSc is installed in
1073 
1074    Not Collective
1075 
1076    Output Parameter:
1077 .  dir - the directory
1078 
1079    Level: developer
1080 
1081    Notes:
1082     Not for use in Fortran
1083 
1084 @*/
1085 PetscErrorCode  PetscGetPetscDir(const char *dir[])
1086 {
1087   PetscFunctionBegin;
1088   *dir = PETSC_DIR;
1089   PetscFunctionReturn(0);
1090 }
1091 
1092 /*@C
1093    PetscStrreplace - Replaces substrings in string with other substrings
1094 
1095    Not Collective
1096 
1097    Input Parameters:
1098 +   comm - MPI_Comm of processors that are processing the string
1099 .   aa - the string to look in
1100 .   b - the resulting copy of a with replaced strings (b can be the same as a)
1101 -   len - the length of b
1102 
1103    Notes:
1104       Replaces   ${PETSC_ARCH},${PETSC_DIR},${PETSC_LIB_DIR},${DISPLAY},
1105       ${HOMEDIRECTORY},${WORKINGDIRECTORY},${USERNAME}, ${HOSTNAME} with appropriate values
1106       as well as any environmental variables.
1107 
1108       PETSC_LIB_DIR uses the environmental variable if it exists. PETSC_ARCH and PETSC_DIR use what
1109       PETSc was built with and do not use environmental variables.
1110 
1111       Not for use in Fortran
1112 
1113    Level: intermediate
1114 
1115 @*/
1116 PetscErrorCode  PetscStrreplace(MPI_Comm comm,const char aa[],char b[],size_t len)
1117 {
1118   PetscErrorCode ierr;
1119   int            i = 0;
1120   size_t         l,l1,l2,l3;
1121   char           *work,*par,*epar,env[1024],*tfree,*a = (char*)aa;
1122   const char     *s[] = {"${PETSC_ARCH}","${PETSC_DIR}","${PETSC_LIB_DIR}","${DISPLAY}","${HOMEDIRECTORY}","${WORKINGDIRECTORY}","${USERNAME}","${HOSTNAME}",0};
1123   char           *r[] = {0,0,0,0,0,0,0,0,0};
1124   PetscBool      flag;
1125 
1126   PetscFunctionBegin;
1127   if (!a || !b) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_NULL,"a and b strings must be nonnull");
1128   if (aa == b) {
1129     ierr = PetscStrallocpy(aa,(char**)&a);CHKERRQ(ierr);
1130   }
1131   ierr = PetscMalloc1(len,&work);CHKERRQ(ierr);
1132 
1133   /* get values for replaced variables */
1134   ierr = PetscStrallocpy(PETSC_ARCH,&r[0]);CHKERRQ(ierr);
1135   ierr = PetscStrallocpy(PETSC_DIR,&r[1]);CHKERRQ(ierr);
1136   ierr = PetscStrallocpy(PETSC_LIB_DIR,&r[2]);CHKERRQ(ierr);
1137   ierr = PetscMalloc1(256,&r[3]);CHKERRQ(ierr);
1138   ierr = PetscMalloc1(PETSC_MAX_PATH_LEN,&r[4]);CHKERRQ(ierr);
1139   ierr = PetscMalloc1(PETSC_MAX_PATH_LEN,&r[5]);CHKERRQ(ierr);
1140   ierr = PetscMalloc1(256,&r[6]);CHKERRQ(ierr);
1141   ierr = PetscMalloc1(256,&r[7]);CHKERRQ(ierr);
1142   ierr = PetscGetDisplay(r[3],256);CHKERRQ(ierr);
1143   ierr = PetscGetHomeDirectory(r[4],PETSC_MAX_PATH_LEN);CHKERRQ(ierr);
1144   ierr = PetscGetWorkingDirectory(r[5],PETSC_MAX_PATH_LEN);CHKERRQ(ierr);
1145   ierr = PetscGetUserName(r[6],256);CHKERRQ(ierr);
1146   ierr = PetscGetHostName(r[7],256);CHKERRQ(ierr);
1147 
1148   /* replace that are in environment */
1149   ierr = PetscOptionsGetenv(comm,"PETSC_LIB_DIR",env,1024,&flag);CHKERRQ(ierr);
1150   if (flag) {
1151     ierr = PetscFree(r[2]);CHKERRQ(ierr);
1152     ierr = PetscStrallocpy(env,&r[2]);CHKERRQ(ierr);
1153   }
1154 
1155   /* replace the requested strings */
1156   ierr = PetscStrncpy(b,a,len);CHKERRQ(ierr);
1157   while (s[i]) {
1158     ierr = PetscStrlen(s[i],&l);CHKERRQ(ierr);
1159     ierr = PetscStrstr(b,s[i],&par);CHKERRQ(ierr);
1160     while (par) {
1161       *par =  0;
1162       par += l;
1163 
1164       ierr = PetscStrlen(b,&l1);CHKERRQ(ierr);
1165       ierr = PetscStrlen(r[i],&l2);CHKERRQ(ierr);
1166       ierr = PetscStrlen(par,&l3);CHKERRQ(ierr);
1167       if (l1 + l2 + l3 >= len) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ,"b len is not long enough to hold new values");
1168       ierr = PetscStrcpy(work,b);CHKERRQ(ierr);
1169       ierr = PetscStrcat(work,r[i]);CHKERRQ(ierr);
1170       ierr = PetscStrcat(work,par);CHKERRQ(ierr);
1171       ierr = PetscStrncpy(b,work,len);CHKERRQ(ierr);
1172       ierr = PetscStrstr(b,s[i],&par);CHKERRQ(ierr);
1173     }
1174     i++;
1175   }
1176   i = 0;
1177   while (r[i]) {
1178     tfree = (char*)r[i];
1179     ierr  = PetscFree(tfree);CHKERRQ(ierr);
1180     i++;
1181   }
1182 
1183   /* look for any other ${xxx} strings to replace from environmental variables */
1184   ierr = PetscStrstr(b,"${",&par);CHKERRQ(ierr);
1185   while (par) {
1186     *par  = 0;
1187     par  += 2;
1188     ierr  = PetscStrcpy(work,b);CHKERRQ(ierr);
1189     ierr  = PetscStrstr(par,"}",&epar);CHKERRQ(ierr);
1190     *epar = 0;
1191     epar += 1;
1192     ierr  = PetscOptionsGetenv(comm,par,env,256,&flag);CHKERRQ(ierr);
1193     if (!flag) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"Substitution string ${%s} not found as environmental variable",par);
1194     ierr = PetscStrcat(work,env);CHKERRQ(ierr);
1195     ierr = PetscStrcat(work,epar);CHKERRQ(ierr);
1196     ierr = PetscStrcpy(b,work);CHKERRQ(ierr);
1197     ierr = PetscStrstr(b,"${",&par);CHKERRQ(ierr);
1198   }
1199   ierr = PetscFree(work);CHKERRQ(ierr);
1200   if (aa == b) {
1201     ierr = PetscFree(a);CHKERRQ(ierr);
1202   }
1203   PetscFunctionReturn(0);
1204 }
1205 
1206 /*@C
1207    PetscEListFind - searches list of strings for given string, using case insensitive matching
1208 
1209    Not Collective
1210 
1211    Input Parameters:
1212 +  n - number of strings in
1213 .  list - list of strings to search
1214 -  str - string to look for, empty string "" accepts default (first entry in list)
1215 
1216    Output Parameters:
1217 +  value - index of matching string (if found)
1218 -  found - boolean indicating whether string was found (can be NULL)
1219 
1220    Notes:
1221    Not for use in Fortran
1222 
1223    Level: advanced
1224 @*/
1225 PetscErrorCode PetscEListFind(PetscInt n,const char *const *list,const char *str,PetscInt *value,PetscBool *found)
1226 {
1227   PetscErrorCode ierr;
1228   PetscBool matched;
1229   PetscInt i;
1230 
1231   PetscFunctionBegin;
1232   if (found) *found = PETSC_FALSE;
1233   for (i=0; i<n; i++) {
1234     ierr = PetscStrcasecmp(str,list[i],&matched);CHKERRQ(ierr);
1235     if (matched || !str[0]) {
1236       if (found) *found = PETSC_TRUE;
1237       *value = i;
1238       break;
1239     }
1240   }
1241   PetscFunctionReturn(0);
1242 }
1243 
1244 /*@C
1245    PetscEnumFind - searches enum list of strings for given string, using case insensitive matching
1246 
1247    Not Collective
1248 
1249    Input Parameters:
1250 +  enumlist - list of strings to search, followed by enum name, then enum prefix, then NUL
1251 -  str - string to look for
1252 
1253    Output Parameters:
1254 +  value - index of matching string (if found)
1255 -  found - boolean indicating whether string was found (can be NULL)
1256 
1257    Notes:
1258    Not for use in Fortran
1259 
1260    Level: advanced
1261 @*/
1262 PetscErrorCode PetscEnumFind(const char *const *enumlist,const char *str,PetscEnum *value,PetscBool *found)
1263 {
1264   PetscErrorCode ierr;
1265   PetscInt n = 0,evalue;
1266   PetscBool efound;
1267 
1268   PetscFunctionBegin;
1269   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");
1270   if (n < 3) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"List argument must have at least two entries: typename and type prefix");
1271   n -= 3; /* drop enum name, prefix, and null termination */
1272   ierr = PetscEListFind(n,enumlist,str,&evalue,&efound);CHKERRQ(ierr);
1273   if (efound) *value = (PetscEnum)evalue;
1274   if (found) *found = efound;
1275   PetscFunctionReturn(0);
1276 }
1277