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