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