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